helpers.pas

一个磁盘文件被删除后恢复的源程序！ 内嵌汇编代码~！

unit helpers;

interface

uses windows, commctrl;


function Byte2Hex(value: byte): shortstring;
function Word2Hex(value: Word): shortstring;

function Byte2Bin(v : byte) : shortstring;
function Word2Bin(v : word) : shortstring;

function Bin2Word(s: shortstring): word;

function Data2Hex(p: pchar; len: integer): shortstring;
procedure Hex2Data(s: shortstring; p: pchar);

function IsDataEqual(buf: pointer; s: shortstring): boolean;
function BytesEqual(buf1, buf2: pointer; size: longword): longword;
function GetNextTextLine(var buf: pointer; maxbufpos: pointer): shortstring;

function Unicode2ASCII(buf: pointer; len: byte): shortstring;
function replace(s: string; old, new: char): string;
function ConvertFmtString(str: string): string;
function AbbreviatePath(pathname: string; maxchars: integer): string;
function fsTimeDate2Str(time, date: word): shortstring;
function LongWordToStr(number: longword): shortstring;
function MatchWildCard(text, pattern: string; OneCharMatch, AllCharMatch: char;
  CaseSensitive: boolean): boolean;

function IsWinNT: boolean;
{: Get the handle of the system's image list.}
function ShellGetSystemImageList(Large: boolean): HImageList;
function ShellGetIconIndex(const APath: string; Attrs: DWORD): integer;
function ShellGetFileInfo(const APath: string; Attrs: DWORD; var Descr: string): integer;
function ShellGetFileType(const APath: string; Attrs: DWORD; var Descr: string): boolean;
function NewDiskFree(rootpath: string): longword;
function ExtractFileNameFaster(pathAndFile: string): string;
function GetRootPath(drivepathname: string): string;


implementation

uses sysutils, shellapi;


// interpretiert \n f黵 RETURN und ersetzt dies durch #13
// kann noch weiter ausgebaut werden
function ConvertFmtString(str: string): string;
var
  i: integer;
begin
  i:=1;
  result:='';
  while i <= length(str) do
  begin
    if str[i] = '\' then
    begin
      inc(i);
      case str[i] of
        '\': result:=result + '\';
        'n': result:=result + #13;
      end;
    end else result:=result+str[i];
    inc(i);
  end;
end;

function fsTimeDate2Str(time, date: word): shortstring;
var
  p: array[0..32] of char;
  t: array[0..4] of uint;
begin
  t[0]:=date AND 31;
  t[1]:=(date SHR 5) AND 15;
  t[2]:=((date SHR 9) AND 127)+1980;

  t[3]:=(time SHR 11) AND 31;
  t[4]:=(time SHR 5) AND 63;

  wvsprintf(@p, '%02u.%02u.%02u %02u:%02u', @t);
  fsTimeDate2Str:=StrPas(p);
end;


function Unicode2ASCII(buf: pointer; len: byte): shortstring;
var
  i: byte;
  res: shortstring;
  w: ^word;
begin
  w:=buf;
  res:=''; i:=0;
  while (w^ <> 0) AND (i < len)do
  begin
    res:=res + chr(w^ AND 255);
    inc(longword(w),2);
    inc(i);
  end;
  Unicode2ASCII:=res;
end;

{ Matches wild card 'pattern' with 'text'
  OneCharMatch is the character for single character matching
  AllCharMatch is the character for all characters matching }
function MatchWildCard(text, pattern: string; OneCharMatch, AllCharMatch: char;
  CaseSensitive: boolean): boolean;
var
  i, tpos, ppos: integer;
  subpattern: string;
begin
  result:=false;
  tpos:=1;
  for ppos:=1 to length(pattern) do
  begin
    if pattern[ppos] = AllCharMatch then
    begin
      // pattern character matches all characters, so get the rest of pattern... 
      subpattern:=copy(pattern, ppos+1, length(pattern)-ppos);
      if subpattern = '' then
      begin
        // if there is no rest, so pattern matches...
        result:=true;
        exit;                      
      end;
      // ...else check for each subtext if it machtes the rest of the pattern
      for i:=tpos to length(text) do
      begin
        result:=MatchWildCard(copy(text, i, length(text)-i+1), subpattern,
          OneCharMatch, AllCharMatch, CaseSensitive);
        if result then exit;
      end;
      exit;
    end else if tpos > length(text) then
    begin
      // no more characters in text to match with => match failed 
      result:=false;
      exit;
    end else if (CaseSensitive AND (pattern[ppos] = text[tpos]))
             OR (pattern[ppos] = OneCharMatch)
             OR (NOT CaseSensitive AND (upcase(pattern[ppos]) = upcase(text[tpos]))) then
    begin
      inc(tpos); // character matches => increase text position
    end else begin
      result:=false;
      exit;
    end;
  end;
  // all characters matches the pattern if there are no more pattern characters to compare with
  result := (tpos = length(text) + 1);
end;



// converts cardinal (32 bit, unsigned) number to string
function LongWordToStr(number: longword): shortstring;
var
  restnumber: longword;
  i: byte;
begin
  restnumber:=number div 10;
  if restnumber > 0 then result:=LongWordToStr(restnumber) + chr(48+(number mod 10))
    else result:=chr(48+(number mod 10));
end;

function Byte2Hex(value: byte): shortstring;
const
  HexCode: array[0..15] of char='0123456789ABCDEF';
var
  h: string[2];
begin
  h:='  ';
  h[1]:=HexCode[value SHR 4];
  h[2]:=HexCode[value AND 15];
  Byte2Hex:=h;
end;

function Word2Hex(value: Word): shortstring;
begin
  Word2Hex := Byte2Hex(hi(value)) + Byte2Hex(lo(value));
end;


function Word2Bin(v : word) : shortstring;
var
  i : byte;
  s : shortstring;
begin
  s:='';
  for i:=1 to 16 do
    if (v shl (i-1)) and 32768=32768 then s:=s+'1' else s:=s+'0';
  Word2Bin:=s;
end;

function Bin2Word(s: shortstring): word;
var
  i: integer;
  value: word;
begin
  result:=0; value:=1;
  i:=0;
  while (i < 16) AND (i < length(s)) do
  begin
    if s[i+1] = '1' then result := result + value;
    value:=value*2;
    inc(i);  
  end;
end;

function Byte2Bin(v : byte) : shortstring;
var
  i : byte;
  s : shortstring;
begin
  s:='';
  for i:=1 to 8 do
    if (v shl (i-1)) and 128=128 then s:=s+'1' else s:=s+'0';
  Byte2Bin:=s;
end;

function DecVal(ch : char) : byte;
begin
  decval:=0;
  if ((ch>='0') and (ch<='9')) then decval := ord(ch)-ord('0');
  if ((ch>='A') and (ch<='F')) then decval := ord(ch)-ord('A')+$0A;
  if ((ch>='a') and (ch<='f')) then decval := ord(ch)-ord('a')+$0A;
end;

function Hex2Dec(s: shortstring): word;
var
  i     : byte;
  tmp   : word;
  place : word;
  error : boolean;
begin
  i := ord(s[0]);
  error := false;
  place := 1;
  tmp := 0;
  while (i>0) and not(error) do begin
    error := not(((s[i]>='0')and(s[i]<='9'))
      or ((s[i]>='a')and(s[i]<='f'))
      or ((s[i]>='A')and(s[i]<='F')));
    tmp := tmp+place*decval(s[i]);
    i:=i-1;
    place := place*$10;
  end;
  if (error) then hex2dec := $00
  else
    hex2dec := tmp;
end;


{ Konvertiert beliebige Daten in Hexadezimal-String
  p: Zeiger auf Daten, len: L鋘ge, result = string }
function Data2Hex(p: pchar; len: integer): shortstring;
const
  HexDigits : array[0..15] of Char = '0123456789ABCDEF';
var
  I: Integer;
  B: Byte;
  s: shortstring;
begin
  s[0]:=char(len*2);
  for I := 0 to len-1 do
  begin
    try
      B := Byte(P[I]);
      s[len*2-(I*2+1)] := HexDigits[B SHR $04];
      s[len*2-I*2] := HexDigits[B AND $0F];
    except
      s[len*2-(i*2+1)]:= '?';
      s[len*2-i*2] := '?';
    end;
  end;
  result:=s;
end;

{ Konvertiert String mit Hexadezimal-Zahlen in Daten-Bytes
  s: string, p: Zeiger auf Buffer, der die Daten aufnehmen soll }
procedure Hex2Data(s: shortstring; p: pchar);
var
  i: integer;
  len: byte;
begin
  len:=length(s);
  for i:= 0 to len div 2-1 do
  begin
    byte(p[i]):=byte(Hex2Dec(s[len-(i*2+1)]+s[len-i*2]));
  end;
end;

{: checks for the length of s if specified data buf is equal specified string }
function IsDataEqual(buf: pointer; s: shortstring): boolean;
var
  i: integer;
begin
  for i:=1 to length(s) do
  begin
    if (byte(buf^) <> ord(s[i])) then
    begin  
      result:=FALSE;
      exit;
    end;
    inc(longword(buf));
  end;
  result:=TRUE;
end;

{: compares <size> bytes of buf1 with buf2 and returns number of NOT equal bytes }
function BytesEqual(buf1, buf2: pointer; size: longword): longword;
var
  i: longint;
  notequal: longword;
begin
  notequal:=0;
  for i:=0 to size-1 do
  begin
    if byte(buf1^) <> byte(buf2^) then inc(notequal);
  end;
  result:=notequal;
end;

{: returns next text line of data stream }
function GetNextTextLine(var buf: pointer; maxbufpos: pointer): shortstring;
var
  s: shortstring;
begin
  s:='';
  while (byte(buf^) <> $0D) AND (byte(pointer(longword(buf)+1)^) <> $0A)
    AND (longword(buf) < longword(maxbufpos)) do
  begin
    s:=s + char(buf^);
    inc(longword(buf));
  end;
  if  longword(buf) < longword(maxbufpos) then inc(longword(buf), 2); // set new start
  result:=s;
end;

function replace(s: string; old, new: char): string;
var
  j: integer;
  res: string;
begin
  res:=s;
  for j:=1 to length(res) do
    if res[j]=old then res[j]:=new;
  replace:=res;
end;

{: converts path+name to max. characters by replacing inner directories with '...' }
function AbbreviatePath(pathname: string; maxchars: integer): string;
var
  i, dstart, dend, dlen: integer;
  s: string;
begin                               
  dstart:=0; dlen:=0;
  i:=1;
  while (i < length(pathname)) AND (length(pathname)-dlen+5 > maxchars) do
  begin
    if pathname[i] = '\' then
    begin
      if dstart = 0 then dstart := i
        else begin
          dend:=i;
          dlen:=dend-dstart+1;
        end;
    end;
    inc(i);
  end;
  s:=pathname;
  if dlen > 0 then
  begin
    s:=copy(pathname, 1, dstart) + '...' + copy(pathname, dend, length(pathname)-dend+1);
  end;
  result:=s;
end;


function IsWinNT: boolean;
var
  info: TOSVersionInfo;
begin
  IsWinNT:=false;
  info.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
  if GetVersionEx(info) then
  begin
    if info.dwPlatformId = VER_PLATFORM_WIN32_NT then IsWinNT:=true;
  end;
end;

function ShellGetSystemImageList(Large: boolean): HImageList;
var
  SFI: TSHFileInfo;
begin
  // SHGetFileInfo puts the requested information in the SFI variable, but it
  // also can return the handle of the system image list.  We just pass an
  // empty file because we aren't interested in it, only the returned handle.
  if Large then
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
                            SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
  else
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
                            SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
end;

function ShellGetIconIndex(const APath: string; Attrs: DWORD): integer;
var
  SFI: TSHFileInfo;
begin
  // File doesn't exist, so Windows doesn't know what to do with it.  We have
  // to tell it by passing the attributes we want, and specifying the
  // SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them.
  SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
                SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.iIcon;
end;

function ShellGetFileInfo(const APath: string; Attrs: DWORD;
   var Descr: string): integer;
var
  SFI: TSHFileInfo;
begin
  SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
             SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  Descr := SFI.szTypeName;
  Result := SFI.iIcon;
end;

function ShellGetFileType(const APath: string; Attrs: DWORD;
   var Descr: string): boolean;
var
  SFI: TSHFileInfo;
begin
  result:=(SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
             SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES) <> 0);
  if result then Descr := SFI.szTypeName;
end;


function NewDiskFree(rootpath: string): longword;
var
  secpclus, bytepsec, freeclus, totalclus: dword;
  a: array[0..4] of char;
begin
  StrPCopy(a, rootpath);
  if GetDiskFreeSpace(a, secpclus, bytepsec, freeclus, totalclus) then
    result:=(secpclus * bytepsec) * freeclus
  else result:=0;
end;

function GetRootPath(drivepathname: string): string;
begin
  result:=drivepathname[1]+':\';
end;

// Wie ExtractFileName, nur schneller! 
function ExtractFileNameFaster(pathAndFile: string): string;
var
  p1, len: integer;
begin
  len:=length(pathAndFile);
  p1:=len;
  while (p1>0) AND (pathAndFile[p1] <> '\') do dec(p1);
  result:=copy(pathAndFile, p1+1, len-p1);
end;



end.