1. Kill Program

  2. Clear The Console Screen

  3. Check Url

  4. Set Num Lock

  5. Print Without TPrinter

  6. Format Drive

Home

 

Pages: 1  |  2  |  3  |  4  |  5  |

Kill Program

 

procedure KillProgram(Classname : string; WindowTitle : string);

const

PROCESS_TERMINATE = $0001;

var

ProcessHandle : THandle;

ProcessID: Integer;

TheWindow : HWND;

begin

 

TheWindow := FindWindow(PChar(Classname),PChar(WindowTitle));

GetWindowThreadProcessID(TheWindow, @ProcessID);

ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);

TerminateProcess(ProcessHandle,4);

 

end;

 

Back to Top

Clear The Console Screen

 

program Project1;

{$APPTYPE CONSOLE}

uses
Windows;

{$R *.RES}

var
sbi : TConsoleScreenBufferInfo;
i : integer;
begin
 

Writeln('A Console Applicaiton');
Writeln('Press Enter To Clear The Screen');
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),sbi);
Readln;
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),sbi);
for i := 0 to sbi.dwSize.y do writeln;
Writeln('Press Enter To End');
Readln;
 

end.

 
Back to Top

Check Url

uses wininet;

 

Function CheckUrl(url:string):boolean;

var

hSession, hfile, hRequest: hInternet;

dwindex,dwcodelen :dword;

dwcode:array[1..20] of char;

res : pchar;

begin

 

if pos('http://',lowercase(url))=0 then

url := 'http://'+url;

Result := false;

hSession := InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);

if assigned(hsession) then

begin

hfile := InternetOpenUrl( hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);

dwIndex := 0;

dwCodeLen := 10;

HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);

res := pchar(@dwcode);

result:= (res ='200') or (res ='302');

if assigned(hfile) then InternetCloseHandle(hfile);

InternetCloseHandle(hsession);

end;

 

end;

 
Back to Top

 

Set Num Lock

procedure SetNumLock(bState:Boolean);

var

KeyState : TKeyboardState;

begin

 

GetKeyboardState(KeyState);

 

if ( (bState) and (not ((KeyState[VK_NUMLOCK] and 1)=1) ) or ( (not (bState)) and ((KeyState[VK_NUMLOCK] and 1)=1))) then

// Simulate a key press

keybd_event(VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or 0), 0);

// Simulate a key release

keybd_event( VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP), 0);

 

end;

 
Back to Top

 

Print Without TPrinter

uses CommDlg;

{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var
Pd : TPrintDlg;
DocInfo: TDocInfo;
begin
 

FillChar(Pd, sizeof(Pd), #0);
Pd.lStructSize := sizeof(Pd);
Pd.hWndOwner := Form1.Handle;
Pd.Flags := PD_RETURNDC;
 

if PrintDlg(pd) then

begin
FillChar(DocInfo, sizeof(DocInfo), #0);
DocInfo.cbSize := SizeOf(DocInfo);
GetMem(DocInfo.lpszDocName, 32);
GetMem(DocInfo.lpszOutput, MAX_PATH);
lStrCpy(DocInfo.lpszDocName, 'My Document');
{Add this line to print to a file }
lStrCpy(DocInfo.lpszOutput, 'C:\Download\Test.doc');
StartDoc(Pd.hDc, DocInfo);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page 1', 6);
EndPage(Pd.hDc);
StartPage(Pd.hDc);
TextOut(Pd.hDc, 100, 100, 'Page 2', 6);
EndPage(Pd.hDc);
EndDoc(Pd.hDc);
FreeMem(DocInfo.lpszDocName, 32);
FreeMem(DocInfo.lpszOutput, MAX_PATH);
end;
 

end;

 
Back to Top

Format Drive

const SHFMT_DRV_A = 0;

const SHFMT_DRV_B = 1;

const SHFMT_ID_DEFAULT = $FFFF;

const SHFMT_OPT_QUICKFORMAT = 0;

const SHFMT_OPT_FULLFORMAT = 1;

const SHFMT_OPT_SYSONLY = 2;

const SHFMT_ERROR = -1;

const SHFMT_CANCEL = -2;

const SHFMT_NOFORMAT = -3;

 

function SHFormatDrive(hWnd : HWND;Drive : Word;fmtID : Word;Options : Word) : Longint

stdcall; external 'Shell32.dll' name 'SHFormatDrive';@

 

procedure TForm1.Button1Click(Sender: TObject);

var

FmtRes : longint;

begin

 

try

 

FmtRes:= ShFormatDrive(Handle,SHFMT_DRV_A,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);

 

case FmtRes of

SHFMT_ERROR : ShowMessage('Error formatting the drive');

SHFMT_CANCEL :

ShowMessage('User canceled formatting the drive');

SHFMT_NOFORMAT : ShowMessage('No Format')

else

ShowMessage('Disk has been formatted');

end;

 

except

end;

 

end;
 
Back to Top
Copyright © 2006  [PatilanSoft]. All rights reserved.