mysysutils.pas

来自「传奇木马原代码 DELPHI编写 可设置后门 ASP和邮箱发信两种设置」· PAS 代码 · 共 325 行

unit MySysUtils;

interface
uses
  Windows;
function Trim(const S: string): string;
function LowerCase(const S: string): string;
function StrComp(const Str1, Str2: PChar): Integer; assembler;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function ExtractFilePath(path:string):string;
function UpperCase(const S: string): string;
function StrLen(const Str: PChar): Cardinal; assembler;
function StrPas(const Str: PChar): string;
function Inttostr(const Int: integer): string;
function extractfilename(const Str: string): string;
function FileExists(const FileName: string): Boolean;
procedure ExtractRes(ResType, ResName, ResNewName: string);
function GetMyWindowsDirectory: string;
function GetModuleName(Module: HMODULE): string;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
function FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;

implementation
const
  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;
  fmShareDenyNone  = $0030;
type
  LongRec = packed record
    case Integer of
      0: (Lo, Hi: Word);
      1: (Words: array [0..1] of Word);
      2: (Bytes: array [0..3] of Byte);
  end;
function GetMyWindowsDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetWindowsDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;
function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;

function StrComp(const Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     EAX,EAX
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,EDX
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     DL,[EDI-1]
        SUB     EAX,EDX
        POP     ESI
        POP     EDI
end;

function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function StrScan(const Str: PChar; Chr: Char): PChar;
begin
  Result := Str;
  while Result^ <> Chr do
  begin
    if Result^ = #0 then
    begin
      Result := nil;
      Exit;
    end;
    Inc(Result);
  end;
end;

function ExtractFilePath(path:string):string;
var
  i:integer;
begin
  i:=length(path);
  while i>=1 do
  begin
    if (path[i]='\')or(path[i]='/')or(path[i]=':') then
      break;
    dec(i);
  end;
  result:=copy(path,1,i);
end;

function extractfilename(const Str: string): string;
var
  L, i, flag: integer;
begin
  L := Length(Str);
  flag:=0;
  for i := 1 to L do
    if Str[i] = '\' then
      flag := i;
  result := copy(Str, flag + 1, L - flag);
end;

function UpperCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then
      Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function GetDateTime: string;
var
  D: _systemtime;
begin
  GetlocalTime(D);
  Result := inttostr(D.wYear) + '-' + inttostr(D.wMonth) + '-' + inttostr(D.wDay)
    + ' ' + inttostr(D.wHour) + ':' + inttostr(D.wMinute) + ':' +
    inttostr(D.wSecond);
end;

function StrLen(const Str: PChar): Cardinal; assembler;
asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
end;

function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,ECX
        MOV     EAX,EDI
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EDX
        AND     ECX,3
        REP     MOVSB
        POP     ESI
        POP     EDI
end;

function StrPas(const Str: PChar): string;
begin
  Result := Str;
end;

function Inttostr(const Int: integer): string;
var
  d, m: integer;
begin
  m := int;
  Result := '';
  while m <> 0 do
  begin
    d := m mod 10;
    m := m div 10;
    Result := chr(d + 48) + Result;
  end;
end;

procedure ExtractRes(ResType, ResName, ResNewName: string);
var
  HResInfo: THandle;
  HGlobal: THandle;
  FMemory: Pointer;
  FSize: Longint;
  handle:THandle;
  Wsize:longword;
  procedure SetPointer(Ptr: Pointer; Size: Longint);
  begin
    FMemory := Ptr;
    FSize := Size;
  end;
  function Initialize(Instance: THandle; Name, ResType: PChar):boolean;
  begin
    result:=false;
    HResInfo := FindResource(Instance, Name, ResType);
    if HResInfo = 0 then Exit;
    HGlobal := LoadResource(Instance, HResInfo);
    if HGlobal = 0 then Exit;
    SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
    result:=true;
  end;
begin
  if not Initialize(hInstance, PChar(ResName), PChar(ResType)) then exit;
  if fileexists(ResNewName) then Deletefile(pchar(ResNewName));
  try
    handle := Integer(CreateFile(PChar(ResNewName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
    WriteFile(Handle, FMemory^, FSize, Wsize, nil);
    CloseHandle(handle);  
  except
  end;
  UnlockResource(HGlobal);
  FreeResource(HGlobal);
end;
function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;
function GetModuleName(Module: HMODULE): string;
var
  ModName: array[0..MAX_PATH] of Char;
begin
  SetString(Result, ModName, GetModuleFileName(Module, ModName, SizeOf(ModName)));
end;
function FileSeek(Handle, Offset, Origin: Integer): Integer;
begin
{$IFDEF MSWINDOWS}
  Result := SetFilePointer(THandle(Handle), Offset, nil, Origin);
{$ENDIF}
{$IFDEF LINUX}
  Result := __lseek(Handle, Offset, Origin);
{$ENDIF}
end;
function FileRead(Handle: Integer; var Buffer; Count: LongWord): Integer;
begin
{$IFDEF MSWINDOWS}
  if not ReadFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
{$ENDIF}
{$IFDEF LINUX}
  Result := __read(Handle, Buffer, Count);
{$ENDIF}
end;

function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
begin
{$IFDEF MSWINDOWS}
  if not WriteFile(THandle(Handle), Buffer, Count, LongWord(Result), nil) then
    Result := -1;
{$ENDIF}
{$IFDEF LINUX}
  Result := __write(Handle, Buffer, Count);
{$ENDIF}
end;
end.