Sumber Kode

HHUtils 1.0 - A collection of useful delphi functions.

  • delphibasics
  • Nov 19' 14
  • Delphi
  • 92
  • 295
  • United States
{
    
Unit : HHUtils
    Coder: steve10120
    Website: hackhound.org
    Compiled: Delphi 7
}
 
unit HHUtils;
 
interface
 
uses
  Windows, PsAPI, TlHelp32;
 
type
  TByteArray = array of Byte;
 
function GetPointerSize(lpBuffer: Pointer): Cardinal;
function PointerFromString(pData:Pointer):string;
function StringToPointer(sData:string):Pointer;
function xShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST;
function ReadFileToMem(sPath:string):Pointer;
function WriteFileFromPointer(pData:Pointer; sPath:string):boolean;
function ReadFileToString(sPath:string):AnsiString;
function WriteFileFromString(sData:string; sPath:string):boolean;
function ReadKeyToString(hRoot:HKEY; sKey:string; sSubKey:string):string;
function WriteKeyFromString(hRoot:HKEY; sKey:string; sSubKey:string; sData:string):boolean;
function UpdateFileResources(sPath: string; pData:Pointer; lpType:PChar; lpName:PChar; bDelete:boolean):boolean;
function GetFileResource(hMod:THandle; lpType:PChar; lpName:PChar):Pointer;
function ReadFileToByteArray(sPath:string):TByteArray;
function WriteFileFromByteArray(bData:TByteArray; sPath:string):boolean;
function FileExists(sPath:string):boolean;
function GetAPIHandle(sLib:string; sProc:string):DWORD;
function KillProcessByName(sName:string):boolean;
function GetProcessPath(PID:DWORD):string;
function GetProcessPriority(dwPID:DWORD):string;
function SetProcessPriority(dwPID:DWORD; pClass:Cardinal):boolean;
function GetWindowState(sText:string):string;
function SetWindowState(sText:string; State:Cardinal):LongBool;
function GetWindowsVersion():string;
function UserName():string;
function GetCountry():string;
function PCName():string;
function StrReverse(sInput:string):string;
function LeftStr(sInput:string; Position:integer):string;
function RightStr(sInput:string; Position:integer):string;
function MidStr(sInput:string; iStart:integer; iEnd:integer):string;
 
implementation
 
function GetPointerSize(lpBuffer: Pointer): Cardinal; // Function by ErazerZ
begin
  if lpBuffer = nil then
    Result := Cardinal(-1)
  else
    Result := Cardinal(Pointer(Cardinal(lpBuffer) -4)^) and $7FFFFFFC -4;
end;
 
function PointerFromString(pData:Pointer):string;
begin
  SetLength(Result, GetPointerSize(pData));
  Move(pData^, Result[1], GetPointerSize(pData));
end;
 
function StringToPointer(sData:string):Pointer;
begin
  GetMem(Result, Length(sData));
  Move(sData[1], Result^, Length(sData));
end;
 
function xShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST;
var
hProc:    DWORD;
begin
  GetProcAddress(LoadLibrary(PChar('shell32')), PChar('ShellExecuteA'));
  asm
    mov hProc, eax
    push ShowCmd
    push Directory
    push Parameters
    push FileName
    push Operation
    push hWnd
    call hProc
  end;
end;
 
function ReadFileToMem(sPath:string):Pointer;
var
hFile:    THandle;
pBuffer:  Pointer;
dSize:    DWORD;
dRead:    DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if hFile <> 0 then
    dSize := GetFileSize(hFile, nil);
    if dSize <> 0 then
    begin
      SetFilePointer(hFile, 0, nil, FILE_BEGIN);
      GetMem(Result, dSize);
      ReadFile(hFile, Result^, dSize, dRead, nil);
      if dRead = 0 then
        MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)
     end;
    CloseHandle(hFile);
end;
 
function WriteFileFromPointer(pData:Pointer; sPath:string):boolean;
var
hFile:    THandle;
dWritten: DWORD;
dSize:    DWORD;
begin
  hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if hFile <> 0 then
  begin
    SetFilePointer(hFile, 0, nil, FILE_BEGIN);
    dSize := GetPointerSize(pData);
    WriteFile(hFile, pData^, dSize, dWritten, nil);
    if dWritten = 0 then
      Result := FALSE
        else
      Result := TRUE;
  end;
  FreeMem(pData, dSize);
  CloseHandle(hFile);
end;
 
function ReadFileToString(sPath:string):AnsiString;
var
hFile:    THandle;
sBuffer:  AnsiString;
dSize:    DWORD;
dRead:    DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if hFile <> 0 then
    dSize := GetFileSize(hFile, nil);
    if dSize <> 0 then
      begin
        SetFilePointer(hFile, 0, nil, FILE_BEGIN);
        SetLength(sBuffer, dSize);
        ReadFile(hFile, sBuffer[1], dSize, dRead, nil);
        if dRead = 0 then
          MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)
            else
          Result := sBuffer;
      end;
    CloseHandle(hFile);
end;
 
function WriteFileFromString(sData:string; sPath:string):boolean;
var
hFile:    THandle;
dWritten: DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile <> 0 then
  begin
    SetFilePointer(hFile, 0, nil, FILE_BEGIN);
    WriteFile(hFile, sData[1], Length(sData), dWritten, nil);
    if dWritten = 0 then
      Result := FALSE
        else
      Result := TRUE;
  end;
  CloseHandle(hFile);
end;
 
// Example: ReadKeyToString(HKEY_LOCAL_MACHINE, 'SOFTWARE\HHC', 'Username')
function ReadKeyToString(hRoot:HKEY; sKey:string; sSubKey:string):string;
var
hOpen:    HKEY;
sBuff:    array[0..255] of char;
dSize:    integer;
begin
  if (RegOpenKeyEx(hRoot, PChar(sKey), 0, KEY_QUERY_VALUE, hOpen) = ERROR_SUCCESS) then
  begin
    dSize := SizeOf(sBuff);
    RegQueryValueEx(hOpen, PChar(sSubKey), nil, nil, @sBuff, @dSize);
    Result := sBuff
  end;
  RegCloseKey(hOpen);
end;
 
// Example: WriteKeyFromString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Example123', 'UserID', '#1')
function WriteKeyFromString(hRoot:HKEY; sKey:string; sSubKey:string; sData:string):boolean;
var
hOpen:    HKEY;
hResult:  HKEY;
begin
  if (RegOpenKeyEx(hRoot, nil, 0, KEY_ALL_ACCESS, hOpen) = ERROR_SUCCESS) then
  begin
    RegCreateKeyEx(hOpen, PChar(sKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hResult, nil);
    if (RegSetValueEx(hResult, PChar(sSubKey), 0, REG_SZ, PChar(sData), Length(sData)) = ERROR_SUCCESS) then
      Result := TRUE
        else
      Result := FALSE;
  end;
  RegCloseKey(hOpen);
end;
 
// Example: UpdateFileResources('C:\test.exe', ReadFileToMem('C:\new.exe'), RT_RCDATA, '123', FALSE);
function UpdateFileResources(sPath: string; pData:Pointer; lpType:PChar; lpName:PChar; bDelete:boolean):boolean;
var
hRes:   THandle;
begin
  hRes := BeginUpdateResource(PChar(sPath), bDelete);
  if hRes <> 0 then
  begin
    UpdateResource(hRes, lpType, lpName, 1033, pData, GetPointerSize(pData));
    EndUpdateResource(hRes, FALSE);
    Result := TRUE;
  end
  else
    Result := FALSE;
end;
 
// Example: GetFileResource(GetModuleHandle(nil), RT_RCDATA, 'HH1')
function GetFileResource(hMod:THandle; lpType:PChar; lpName:PChar):Pointer;
var
hRes, hLoad:  THandle;
dSize:        DWORD;
begin
  hRes := FindResource(hMod, lpName, lpType);
  if hRes <> 0 then
    dSize := SizeofResource(hMod, hRes);
    if dSize <> 0 then
    begin
      hLoad := LoadResource(hMod, hRes);
      Result := LockResource(hLoad);
    end;
end;
 
function ReadFileToByteArray(sPath:string):TByteArray;
var
hFile:    THandle;
dSize:    DWORD;
dRead:    DWORD;
bBuff:    array of Byte;
i:        integer;
begin
  hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if hFile <> 0 then
    dSize := GetFileSize(hFile, nil);
    if dSize <> 0 then
      begin
        SetFilePointer(hFile, 0, nil, FILE_BEGIN);
        SetLength(bBuff, dSize);
        ReadFile(hFile, bBuff[1], dSize, dRead, nil);
        if dRead = 0 then
          MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)
          else
          begin
            SetLength(Result, dSize);
            for i := 0 to dSize do
              Result[i] := bBuff[i + 1];
            end;
      end;
end;
 
// Example: WriteFileFromByteArray(ReadFileToByteArray('C:\test.exe'), 'C:\bytearray.exe')
function WriteFileFromByteArray(bData:TByteArray; sPath:string):boolean;
var
hFile:    THandle;
dWritten: DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile <> 0 then
  begin
    SetFilePointer(hFile, 0, nil, FILE_BEGIN);
    WriteFile(hFile, bData[0],Length(bData), dWritten, nil);
    if dWritten = 0 then
      Result := FALSE
        else
      Result := TRUE;
  end;
  CloseHandle(hFile);
end;
 
function FileExists(sPath:string):boolean;
var
hFile:    THandle;
FDATA:    TWin32FindData;
begin
  hFile := FindFirstFile(PChar(sPath), FDATA);
  if hFile = INVALID_HANDLE_VALUE then
    Result := FALSE
      else
    Result := TRUE;
  CloseHandle(hFile);
end;
 
{ GetAPIHandle Example:
 var
xShellExecute:  DWORD;
sFile:          PChar;
begin
 
xShellExecute := GetAPIHandle('shell32', 'ShellExecuteA');
sFile := 'C:\test.exe';
 
asm
  push 1
  push 0
  push 0
  push sFile
  push 0
  push 0
  call xShellExecute
end; }
 
function GetAPIHandle(sLib:string; sProc:string):DWORD;
var
hProc:    DWORD;
begin
  GetProcAddress(LoadLibrary(PChar(sLib)), PChar(sProc));
    asm
      mov hProc, eax
    end;
  if hProc <> 0 then
  Result := hProc;
end;
 
function KillProcessByName(sName:string):boolean;
var
hOpen, hSnap:   THandle;
PROC:           TPROCESSENTRY32;
hProc:          LongBool;
begin
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hSnap <> 0 then
    PROC.dwSize := SizeOf(PROC);
    if (Process32First(hSnap, PROC)) then
    begin
      while hProc <> FALSE do
      begin
        if sName = PROC.szExeFile then
        begin
          hOpen := OpenProcess(PROCESS_TERMINATE, FALSE, PROC.th32ProcessID);
          if (TerminateProcess(hOpen, 0)) then
            Result := TRUE
              else
            Result := FALSE;
          CloseHandle(hOpen);
        end;
        hProc := Process32Next(hSnap, PROC);
      end;
    end;
end;
 
function GetProcessPath(PID:DWORD):string;
var
hOpen:    THandle;
sBuff:    array[0..255] of char;
begin
  hOpen := OpenProcess(PROCESS_VM_READ or PROCESS_QUERY_INFORMATION, FALSE, PID);
  if hOpen <> 0 then
  begin
    GetModuleFileNameEx(hOpen, 0, sBuff, SizeOf(sBuff));
    Result := sBuff;
  end;
  CloseHandle(hOpen);
end;
 
function GetProcessPriority(dwPID:DWORD):string;
var
hOpen:    THandle;
lClass:   Cardinal;
begin
  hOpen  := OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, FALSE, dwPID);
  if hOpen <> 0 then
  begin
    lClass := GetPriorityClass(hOpen);
    if lClass = NORMAL_PRIORITY_CLASS then
      Result := 'Normal'
    else if lClass = IDLE_PRIORITY_CLASS then
      Result := 'Idle'
    else if lClass = HIGH_PRIORITY_CLASS then
      Result := 'High'
    else if lClass = REALTIME_PRIORITY_CLASS then
      Result := 'Real Time'
    else
      Result := '-';
  end;
  CloseHandle(hOpen);
end;
 
// Example: SetProcessPriority(10120, NORMAL_PRIORITY_CLASS);
function SetProcessPriority(dwPID:DWORD; pClass:Cardinal):boolean;
var
hOpen:    THandle;
begin
  hOpen := OpenProcess(PROCESS_SET_INFORMATION, FALSE, dwPID);
  if hOpen <> 0 then
    if SetPriorityClass(hOpen, pClass) then
      Result := TRUE
        else
      Result := FALSE;
  CloseHandle(hOpen);
end;
 
function GetWindowState(sText:string):string;
var
PLACE:        TWindowPlacement;
hWindow:      HWND;
begin
  hWindow := FindWindow(nil, PChar(sText));
  if hWindow <> 0 then
  begin
    PLACE.length := SizeOf(PLACE);
    GetWindowPlacement(hWindow, @PLACE);
    if PLACE.showCmd = SW_SHOWMAXIMIZED then
      Result := 'Maximized'
    else if PLACE.showCmd = SW_SHOWNORMAL then
      Result := 'Normal'
    else if PLACE.showCmd = SW_SHOWMINIMIZED then
      Result := 'Minimized';
  end;
  CloseHandle(hWindow);
end;
 
// Example: SetWindowState('Notepad'), SW_SHOW);
function SetWindowState(sText:string; State:Cardinal):LongBool;
var
hWindow:  HWND;
SETPLACE: TWindowPlacement;
begin
  hWindow := FindWindow(nil, PChar(sText));
  if hWindow <> 0 then
  begin
    SETPLACE.length  := SizeOf(SETPLACE);
    SETPLACE.showCmd := State;
    if (SetWindowPlacement(hWindow, @SETPLACE)) then
      Result := TRUE
        else
      Result := FALSE;
  end;
  CloseHandle(hWindow);
end;
 
function GetWindowsVersion():string;
var
OSINFO:   TOSVERSIONINFO;
begin
  OSINFO.dwOSVersionInfoSize := SizeOf(OSINFO);
  GetVersionEx(OSINFO);
  if OSINFO.dwMajorVersion = 3 then
    Result := 'Windows 3.11'
  else if OSINFO.dwMajorVersion = 4 then
    Result := 'Windows 2000'
  else if OSINFO.dwMajorVersion = 5 then
    Result := 'Windows XP'
  else if OSINFO.dwMajorVersion = 6 then
    Result := 'Windows Vista'
end;
 
function UserName():string;
var
sBuff:    array[0..256] of char;
dSize:    Cardinal;
begin
  dSize := 256;
  GetUserName(sBuff, dSize);
  Result := sBuff;
end;
 
function GetCountry():string;
var
sBuff:    array[0..256] of char;
dSize:    integer;
begin
  GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_SENGCOUNTRY, sBuff, 256);
  Result := sBuff;
end;
 
function PCName():string;
var
sBuff:    array[0..256] of char;
dSize:    Cardinal;
begin
  dSize := 256;
  GetComputerName(sBuff, dSize);
  Result := sBuff;
end;
 
function StrReverse(sInput:string):string;
var
Count:    integer;
begin
  For Count := 0 to Length(sInput) do
  begin
    Result := Result + sInput[Length(sInput) - Count]
  end;
end;
 
function LeftStr(sInput:string; Position:integer):string;
var
Count:  integer;
begin
  For Count := 1 to Position do
  begin
    Result := Result + sInput[Count];
  end;
end;
 
function RightStr(sInput:string; Position:integer):string;
var
Count:  integer;
begin
  For Count := Length(sInput) - Position + 1 to Length(sInput) do
  begin
    Result := Result + sInput[Count];
  end;
end;
 
function MidStr(sInput:string; iStart:integer; iEnd:integer):string;
var
Count:  integer;
begin
  For Count := iStart to iEnd do
  begin
    Result := Result + sInput[Count]
  end;
end;
 
end.
Powered by
Pasar Kode Partner

Share

  • Tags :
comments powered by Disqus

Kode Terkait

Screen Capture with Pure Windows API

Programmatically talk using Microsoft Sam

Modify TEdit to include text alignment

Delphi RC4 Encryption Source Code

Update PE CheckSum

Enumerate Processes using Native Windows API

Self-Deleting File - "Melting"

Change ImageBase of a PE File

Reduce the units included in the uses



Kategori