Posts

Showing posts from March, 2006

Microsoft Patch API

unit Patchapi;

interface

uses
Windows, SysUtils;

const
PATCH_OPTION_USE_BEST = $00000000; // auto choose best (slower)
PATCH_OPTION_USE_LZX_BEST = $00000003; // auto choose best of LZX
PATCH_OPTION_USE_LZX_A = $00000001; // normal
PATCH_OPTION_USE_LZX_B = $00000002; // better on some x86 binaries
PATCH_OPTION_USE_LZX_LARGE = $00000004; // better support for files >8MB
PATCH_OPTION_NO_BINDFIX = $00010000; // PE bound imports
PATCH_OPTION_NO_LOCKFIX = $00020000; // PE smashed locks
PATCH_OPTION_NO_REBASE = $00040000; // PE rebased image
PATCH_OPTION_FAIL_IF_SAME_FILE = $00080000; // don't create if same
PATCH_OPTION_FAIL_IF_BIGGER = $00100000; // fail if patch is larger than simply compressing new file (slower)
PATCH_OPTION_NO_CHECKSUM = $00200000; // PE checksum zero
PATCH_OPTION_NO_RESTIMEFIX = $00400000; // PE resource timestamps
PATCH_OPTION_NO_TIMESTAMP = $00800000; // don't store new file timestamp in patch
PATCH_OPTION_SIGNATURE_MD5 = $01000000…

Using waitable timer in Delphi

procedure Wait(lNumberOfSeconds : Longint);
const
_SECOND = 10000000;
var
lBusy : LongInt;
hTimer : LongInt;
liDueTime : LARGE_INTEGER;

begin
hTimer := CreateWaitableTimer(nil, True, 'WaitableTimer');
if hTimer = 0 then
Exit;
liDueTime.QuadPart := -10000000 * lNumberOfSeconds;
SetWaitableTimer(hTimer, TLargeInteger(liDueTime), 0, nil, nil, False);

repeat
lBusy := MsgWaitForMultipleObjects(1, hTimer, False,
INFINITE, QS_ALLINPUT);
Application.ProcessMessages;
Until lBusy = WAIT_OBJECT_0;

// Close the handles when you are done with them.
CloseHandle(hTimer);

End;
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Caption := 'start';
wait(10);
form1.Caption := 'done';
end;

Using HourGlass cursor and autorestore it to default application cursor

{*****************************************************************************
Name : WaitForTask
Author : Perevoznyk Serhiy
Description :
History :

Date By Description
---- -- -----------
08-07-2005 Perevoznyk Serhiy Initial creation of the Unit.
*****************************************************************************}

unit WaitForTask;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms;

type
TCursorRestorer = class(TInterfacedObject)
private
FCursor : TCursor;
FWindowHandle: HWND;
FWaitTime : integer;
protected
procedure WndProc(var Msg: TMessage);
public
constructor Create(WaitTime : integer =0); virtual;
destructor Destroy; override;
procedure Restore;
end;

function Busy(WaitTime : integer = 0) : IUnknown;
procedure WaitSleep(MS : Longint);

implementation


{ TCursorRestorer }

constructor TCursorRestorer.Create;
begin
inherited Create;
FCursor := …

Simple way to execute ADO Query

With this unit you can create and execute queries without using ADO components. The size of application is dramatically smaller....



unit ADOSupport;

interface

uses
Windows,
SysUtils,
ActiveX,
ADOInt;

function ExecuteADOSQL(ConnectionString : string; UserName : string; Password : string; command : string) : integer;
function CreateADOConnection(ConnectionString : string; UserName : string; Password : string) : _Connection;
procedure ExecuteADOQuery(Connection : _Connection; command : string);
procedure CloseConnection(Connection : _Connection);

implementation

function Succeeded(Res: HResult): Boolean;
begin
Result := Res and $80000000 = 0;
end;

function CreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IUnknown, Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
if (Status = REGDB_E_CLASSNOTREG) then
raise Excepti…