SN-FDD-UTILS/HELPERS.PAS

unit helpers;

interface

function strlo(s: string): string;
function mid(str: string; ind1,ind2: integer): string;
function nosp(s: string): string;
function strr(value: longint): string;
function vall(value: string): longint;

function hob2pc(name: string): string;
function CheckFile(myfile: string): byte;
function GetOf(fullpath: string; what: byte): string;
function CheckEx(myfile: string): string;

function dec2hex(decn: string): string;

implementation

uses
  dos;

{----------------------------------------------------------------------------}
function strlo(s: string): string;
var
  f: byte;
  a: string;
  x: byte;
begin
  a:= '';
  for f:= 1 to Length(s) do
  begin
    x:= 0;
    if (((s[f] >= 'A')and(s[f] <= 'Z'))or((s[f] >= 'À')and(s[f] <= 'Ï'))) then x:= 32;
    if (s[f] >= 'Ð')and(s[f] <= 'ß') then x:= 80;
    a:= a + chr(ord(s[f]) + x);
  end;

strlo:= a;
end;

{----------------------------------------------------------------------------}
function mid(str: string; ind1,ind2: integer): string;
begin
  mid:= Copy(str, ind1, ind2-ind1+1);
end;

{----------------------------------------------------------------------------}
function nosp(s: string): string;
var
  f,l,r: byte;
  a: string;
begin
  a:= '';
  l:=1; while s[l]=' ' do inc(l);
  r:= length(s); while s[r]=' ' do dec(r);

  nosp:= mid(s,l,r);
end;

{----------------------------------------------------------------------------}
function strr(value: longint): string;
var
  r: string;
begin
  str(value, r);

  strr:= r;
end;

{----------------------------------------------------------------------------}
function vall(value: string): longint;
var
  rrr: longint;
  code: integer;
begin
  val(value, rrr, code);
  vall:= rrr;
end;

{----------------------------------------------------------------------------}
function hob2pc(name: string): string;
var
  i, m: byte;
  s, d: string;
begin
  s:= nosp(mid(name,1,8));
  d:= copy(strlo(s), 1, 3);
  if (d='com') or (d='lpt') or (d='nul') or (d='con') or (d='aux') or (d='prn') then s:= s + d;

  for i:= 1 to length(s) do
  begin
    if s[i] = ' ' then s[i]:= '_';
    if s[i] in ['.',':',',','\','/','?','*','>','<','+','"',#39] then s[i]:= '-';
    if s[i] = #0 then s[i]:= '0';
    if s[i] = #1 then s[i]:= '1';
    if s[i] = #2 then s[i]:= '2';
    if s[i] = #3 then s[i]:= '3';
    if s[i] = #4 then s[i]:= '4';
    if s[i] = #5 then s[i]:= '5';
    if s[i] = #6 then s[i]:= '6';
    if s[i] = #7 then s[i]:= '7';
    if s[i] = #8 then s[i]:= '8';
    if s[i] = #9 then s[i]:= '9';
    if s[i] = #10 then s[i]:= 'A';
    if s[i] = #11 then s[i]:= 'B';
    if s[i] = #12 then s[i]:= 'C';
    if s[i] = #13 then s[i]:= 'D';
    if s[i] = #14 then s[i]:= 'E';
    if s[i] = #15 then s[i]:= 'F';
    if s[i] = #16 then s[i]:= 'G';
    if s[i] = #17 then s[i]:= 'H';
    if s[i] = #18 then s[i]:= 'I';
    if s[i] = #19 then s[i]:= 'J';
    if s[i] = #20 then s[i]:= 'K';
    if s[i] = #21 then s[i]:= 'L';
    if s[i] = #22 then s[i]:= 'M';
    if s[i] = #23 then s[i]:= 'N';
    if s[i] = #24 then s[i]:= 'O';
    if s[i] = #25 then s[i]:= 'P';
    if s[i] = #26 then s[i]:= 'Q';
    if s[i] = #27 then s[i]:= 'R';
    if s[i] = #28 then s[i]:= 'S';
    if s[i] = #29 then s[i]:= 'T';
    if s[i] = #30 then s[i]:= 'U';
    if s[i] = #31 then s[i]:= 'V';
  end;

  hob2pc:= s;
end;
   
{----------------------------------------------------------------------------}
{$I-}
function CheckFile(myfile: string): byte;
var
  ff: searchrec;
begin
  filemode:= 0;
  findfirst(myfile, anyfile, ff);
  CheckFile:= doserror;
end;
{$I+}

{----------------------------------------------------------------------------}
function GetOf(fullpath: string; what: byte): string;
var
  dosdir  :dirstr;
  dosname :namestr;
  dosext  :extstr;
begin
  FSplit(fullpath, dosdir, dosname, dosext);
  if length(dosdir) <> 3 then dosdir := Copy(dosdir, 1, Length(dosdir)-1);
  case what of
    1: GetOf := dosdir;
    2: GetOf := dosname;
    3: GetOf := dosext;
  end;
end;

{----------------------------------------------------------------------------}
function CheckEx(myfile: string): string;
var
  e: byte;
  s,t,fn,ex: string;
  i: longint;
begin
  CheckEx:= myfile;

  {file exists}
  e:= CheckFile(myfile);
  if e <> 0 then
    exit;

  fn:= GetOf(myfile,2);
  ex:= GetOf(myfile,3);

  i:= 0;
  while (e = 0) do
  begin
    inc(i);
    t:= strr(i);
    s:= copy(fn,1,5);
    s:= s + copy('00000000', 1, 8-length(s)-length(t)) + t;

    e:= CheckFile(s+ex);
  end;

  CheckEx:= s+ex;
end;

{----------------------------------------------------------------------------}
function dec2hex(decn: string): string;
var
  hex: string;
  f, tdec, valcode, h3, h4: integer;
  decm: array [1..2] of real;
  i: longint;
label 
  fin;
begin
  hex:= '';
  Val(decn, tdec, valcode);
  if (tdec < 0) or (tdec > 65535) then
  begin
    hex:= 'error';
    goto fin;
  end;
  decm[1]:= int(tdec / 256);
  decm[2]:= tdec - 256 * decm[1];
  for i:= 1 to 2 do
  begin
    h3:= 48;
    h4:= 48;
    for f:= 1 to round(decm[i]) do
    begin
      h4:= h4 + 1;
      if (h4 > 57) and (h4 < 65) then
        h4:= h4 + 7;
      if h4 > 70 then
      begin
        h3:= h3 + 1;
        h4:= 48;
      end;
      if (h3 > 57) and (h3 < 65) then
        h3:= h3 + 7;
    end;
    hex:= hex + chr(h3) + chr(h4);
  end;
fin:
  if vall(decn) > 255 then
    dec2hex:= hex
  else
    dec2hex:= copy(hex, 3, 2);
end;

end.