helpers.pas

MysqlFront的源码

  randomize();
  result := '';
  salt := random(9) + 1;
  for i:=1 to length(str) do begin
    nr := ord(str[i])+salt;
    if nr > 255 then
      nr := nr - 255;
    h := inttohex(nr,0);
    if length(h) = 1 then
      h := '0' + h;
    result := result + h;
  end;
  result := result + inttostr(salt);
end;


// password-decryption
function decrypt(str: String) : String;
var
  j, salt, nr : integer;
begin
  j := 1;
  salt := StrToIntDef(str[length(str)],0);
  result := '';
  while j < length(str)-1 do begin
    nr := StrToInt('$' + str[j] + str[j+1]) - salt;
    if nr < 0 then
      nr := nr + 255;
    result := result + chr(nr);
    inc(j, 2);
  end;
end;


// convert html-chars to their entities
function htmlentities(str: String) : String;
begin
  result := stringreplace(str, '<', '&lt;', [rfReplaceAll]);
  result := stringreplace(result, '>', '&gt;', [rfReplaceAll]);
  result := stringreplace(result, '&', '&amp;', [rfReplaceAll]);
end;


// convert TColor to HTML-color-string
function color2rgb(c:TColor):longint;
var
  temp:longint;
begin
  temp:=colortorgb(c);
  result:=((temp and $ff) shl 16) or (temp and $ff00) or ((temp and $ff0000) shr 16);
end;


// return ASCII-Values from MySQL-Escape-Sequences
function esc2ascii(str: String): String;
begin
  str := stringreplace(str, '\r', #13, [rfReplaceAll]);
  str := stringreplace(str, '\n', #10, [rfReplaceAll]);
  str := stringreplace(str, '\t', #9, [rfReplaceAll]);
  result := str;
end;


// Get maximum value
function Max(A, B: Integer): Integer; assembler;
asm
  CMP EAX,EDX
  JG  @Exit
  MOV EAX,EDX
@Exit:
end;

// Get minimum value
function Min(A, B: Integer): Integer; assembler;
asm
  CMP EAX,EDX
  JL  @Exit
  MOV EAX,EDX
@Exit:
end;


// string compare from the begin
function StrCmpBegin(Str1, Str2: string): Boolean;
begin
  if ((Str1 = '') or (Str2 = '')) and (Str1 <> Str2) then
    Result := False
  else
    Result := (StrLComp(PChar(Str1), PChar(Str2),
      Min(Length(Str1), Length(Str2))) = 0);
end;


function urlencode(url: String): String;
begin
  result := stringreplace(url, ' ', '+', [rfReplaceAll]);
end;


// Write str to FileStream
procedure wfs( var s: TFileStream; str: String = '');
begin
  str := str + crlf;
  s.Write(pchar(str)^, length(str))
end;



procedure ToggleCheckListBox(list: TCheckListBox; state: Boolean);
var
  i : Integer;
begin
  // select all/none
  for i:=0 to list.Items.Count-1 do
    list.checked[i] := state;
end;


function _GetFileSize(filename: String): Int64;
var
  i64: record
    LoDWord: LongWord;
    HiDWord: LongWord;
  end;
  stream : TFileStream;
begin
  try
    Stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
    i64.LoDWord := GetFileSize(Stream.Handle, @i64.HiDWord);
  finally
    Stream.Free;
  end;
  if (i64.LoDWord = MAXDWORD) and (GetLastError <> 0) then
    Result := 0
  else
    Result := PInt64(@i64)^;
end;



{=========================================================}
Function Mince(PathToMince: String; InSpace: Integer): String;
{=========================================================}
// "C:\Program Files\Delphi\DDrop\TargetDemo\main.pas"
// "C:\Program Files\..\main.pas"
Var
  sl: TStringList;
  sHelp, sFile: String;
  iPos: Integer;

Begin
  sHelp := PathToMince;
  iPos := Pos('\', sHelp);
  If iPos = 0 Then
  Begin
    Result := PathToMince;
  End
  Else
  Begin
    sl := TStringList.Create;
    // Decode string
    While iPos <> 0 Do
    Begin
      sl.Add(Copy(sHelp, 1, (iPos - 1)));
      sHelp := Copy(sHelp, (iPos + 1), Length(sHelp));
      iPos := Pos('\', sHelp);
    End;
    If sHelp <> '' Then
    Begin
      sl.Add(sHelp);
    End;
    // Encode string
    sFile := sl[sl.Count - 1];
    sl.Delete(sl.Count - 1);
    Result := '';
    While (Length(Result + sFile) < InSpace) And (sl.Count <> 0) Do
    Begin
      Result := Result + sl[0] + '\';
      sl.Delete(0);
    End;
    If sl.Count = 0 Then
    Begin
      Result := Result + sFile;
    End
    Else
    Begin
      Result := Result + '..\' + sFile;
    End;
    sl.Free;
  End;
End;


procedure RenameRegistryItem(AKey: HKEY; Old, New: String);

var OldKey,
    NewKey  : HKEY;
    Status  : Integer;

begin
  // Open Source key
  Status:=RegOpenKey(AKey,PChar(Old),OldKey);
  if Status = ERROR_SUCCESS then
  begin
    // Create Destination key
    Status:=RegCreateKey(AKey,PChar(New),NewKey);
    if Status = ERROR_SUCCESS then CopyRegistryKey(OldKey,NewKey);
    RegCloseKey(OldKey);
    RegCloseKey(NewKey);
    // Delete last top-level key
    RegDeleteKey(AKey,PChar(Old));
  end;
end;

//--------------------------------------------------------------------------------

procedure CopyRegistryKey(Source, Dest: HKEY);

const DefValueSize  = 512;
      DefBufferSize = 8192;

var Status      : Integer;
    Key         : Integer;
    ValueSize,
    BufferSize  : Cardinal;
    KeyType     : Integer;
    ValueName   : String;
    Buffer      : Pointer;
    NewTo,
    NewFrom     : HKEY;

begin
  SetLength(ValueName,DefValueSize);
  Buffer:=AllocMem(DefBufferSize);
  try
    Key:=0;
    repeat
      ValueSize:=DefValueSize;
      BufferSize:=DefBufferSize;
      //  enumerate data values at current key
      Status:=RegEnumValue(Source,Key,PChar(ValueName),ValueSize,nil,@KeyType,Buffer,@BufferSize);
      if Status = ERROR_SUCCESS then
      begin
        // move each value to new place
        Status:=RegSetValueEx(Dest,PChar(ValueName),0,KeyType,Buffer,BufferSize);
         // delete old value
        RegDeleteValue(Source,PChar(ValueName));
      end;
    until Status <> ERROR_SUCCESS; // Loop until all values found

    // start over, looking for keys now instead of values
    Key:=0;
    repeat
      ValueSize:=DefValueSize;
      BufferSize:=DefBufferSize;
      Status:=RegEnumKeyEx(Source,Key,PChar(ValueName),ValueSize,nil,Buffer,@BufferSize,nil);
      // was a valid key found?
      if Status = ERROR_SUCCESS then
      begin
        // open the key if found
        Status:=RegCreateKey(Dest,PChar(ValueName),NewTo);
        if Status = ERROR_SUCCESS then
        begin                                       //  Create new key of old name
          Status:=RegCreateKey(Source,PChar(ValueName),NewFrom);
          if Status = ERROR_SUCCESS then
          begin
            // if that worked, recurse back here
            CopyRegistryKey(NewFrom,NewTo);
            RegCloseKey(NewFrom);
            RegDeleteKey(Source,PChar(ValueName));
          end;
          RegCloseKey(NewTo);
        end;
      end;
    until Status <> ERROR_SUCCESS; // loop until key enum fails
  finally
    FreeMem(Buffer);
  end;
end;

//--------------------------------------------------------------------------------

procedure DeleteRegistryKey(Key: HKEY);

const DefValueSize  = 512;
      DefBufferSize = 8192;

var Status     : Integer;
    Index      : Integer;
    ValueSize,
    BufferSize : Cardinal;
    KeyType    : Integer;
    ValueName  : String;
    Buffer     : Pointer;
    SubKey     : HKEY;

begin
  SetLength(ValueName,DefValueSize);
  Buffer:=AllocMem(DefBufferSize);
  try
    Index:=0;
    repeat
      ValueSize:=DefValueSize;
      BufferSize:=DefBufferSize;
      // enumerate data values at current key
      Status:=RegEnumValue(Key,Index,PChar(ValueName),ValueSize,nil,@KeyType,Buffer,@BufferSize);
      // delete old value
      if Status = ERROR_SUCCESS then RegDeleteValue(Key,PChar(ValueName));
    until Status <> ERROR_SUCCESS; // Loop until all values found

    // start over, looking for keys now instead of values
    Index:=0;
    repeat
      ValueSize:=DefValueSize;
      BufferSize:=DefBufferSize;
      Status:=RegEnumKeyEx(Key,Index,PChar(ValueName),ValueSize,nil,Buffer,@BufferSize,nil);
      // was a valid key found?
      if Status = ERROR_SUCCESS then
      begin
        // open the key if found
        Status:=RegOpenKey(Key,PChar(ValueName),SubKey);
        if Status = ERROR_SUCCESS then
        begin
          // if that worked, recurse back here
          DeleteRegistryKey(SubKey);
          RegCloseKey(SubKey);
          RegDeleteKey(Key,PChar(ValueName));
        end;
      end;
    until Status <> ERROR_SUCCESS; // loop until key enum fails
  finally
    FreeMem(Buffer);
  end;
end;

function MakeInt( Str: String ) : Integer;
var
  test, i : Integer;
  StrWithInts : String;
begin
  StrWithInts := '';
  for i:=1 to Length(str) do
  begin
    if StrToIntDef( str[i], -1 ) <> -1 then
    begin
      StrWithInts := StrWithInts + str[i];
    end;
  end;
  result := StrToIntDef( StrWithInts, 0 );
end;

end.