?? helpers.pas
字號:
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, '<', '<', [rfReplaceAll]);
result := stringreplace(result, '>', '>', [rfReplaceAll]);
result := stringreplace(result, '&', '&', [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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -