Часто задаваемые Вопросы.. F.A.Q.

• Как проверить подключен ли компьютер к internet ?
• Вообщем ситуация: нужно отправить созданное моей программой письмо по е-майлу независимо от юзера т.е. чтобы он не подозревал об отправке. Вот бы это на АПИ с примером!
• Скажите пожалуйста могу ли я из своей программы закрыть чужое приложение и как?
• Кто-нибудь может кинуть мне пример программирования COM портов
• Подскажите какие ХОРОШИЕ программы есть для создания ИНТАЛЯШЕК
• Как получить сеpийные номеpа биоса и т.п.?
• Как вызвать процедуру из чужого ЕХЕ файла
• Можно-ли из Дельфей вызвать Outlook и автоматически послать месаги
• Как можно подключить dll`ку и как использовать её функции...
• dialup и delphi
• Доступ к памяти чужой программы
• TWebBrowser
• Как зарегистрировать свое расшерения для файлов? Т.е. чтобы при щелчке по такому файлу вызывалась моя программа.
• Принтер в Delphi
• Как програмно перезагрузить Windows?
• TTimer работает не достаточно точно. Как получить более высокую точность?
• Как получить имена свободных com портов?
• Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
• Курсор мыши за границами активной формы.
• Как послать message всем?
• Работа с принтером.
• Как стереть ехе-файл во время его исполнения?
• Как получить дескриптор окна другого приложения и сделать его активным?
• В своей программе я запускаю с помощью CreateProcess приложение (например Notepad), мне необходимо передать Message в окно этого приложения.
• Как скопировать директорию

interface  
uses  
  Windows, SysUtils, Registry, WinSock, WinInet;  

type  
  TConnectionType = (ctNone, ctProxy, ctDialup);  

function ConnectedToInternet : TConnectionType;  
function RasConnectionCount : Integer;  
   

implementation  

//For RasConnectionCount =======================  
const  
  cERROR_BUFFER_TOO_SMALL = 603;  
  cRAS_MaxEntryName       =  256;  
  cRAS_MaxDeviceName      =  128;  
  cRAS_MaxDeviceType      =  16;  
type  
  ERasError = class(Exception);  

  HRASConn = DWord;  
  PRASConn = ^TRASConn;  
  TRASConn = record  
     dwSize: DWORD;  
     rasConn: HRASConn;  
     szEntryName: Array[0..cRAS_MaxEntryName] Of Char;  
     szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;  
     szDeviceName : Array [0..cRAS_MaxDeviceName] of char;  
  end;  

  TRasEnumConnections =  
      function (RASConn: PrasConn; { buffer to receive Connections data }  
                var BufSize: DWord;    { size in bytes of buffer }  
                var Connections: DWord { number of Connections written to buffer }  
                ): LongInt; stdcall;  
//End RasConnectionCount =======================  
   

function ConnectedToInternet: TConnectionType;  
var  
  Reg       : TRegistry;  
  bUseProxy : Boolean;  
  UseProxy  : LongWord;  
begin  
  Result := ctNone;  
  Reg := TRegistry.Create;  
  with REG do  
  try  
    try  
      RootKey := HKEY_CURRENT_USER;  
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet settings',False) then begin  
        //I just try to read it, and trap an exception  
        if GetDataType('ProxyEnable') = rdBinary then  
          ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )  
        else begin  
          bUseProxy := ReadBool('ProxyEnable');  
          if bUseProxy then  
            UseProxy := 1  
          else  
            UseProxy := 0;  
        end;  
        if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy;  
      end;  
    except  
      //Obviously not connected through a proxy  
    end;  
  finally  
    Free;  
  end;  

  //We can check RasConnectionCount even if dialup networking is not installed  
  //simply because it will return 0 if the DLL is not found.  
  if Result = ctNone then begin  
    if RasConnectionCount > 0 then Result := ctDialup;  
  end;  
end;  

function RasConnectionCount : Integer;  
var  
  RasDLL    : HInst;  
  Conns     : Array[1..4] of TRasConn;  
  RasEnums  : TRasEnumConnections;  
  BufSize   : DWord;  
  NumConns  : DWord;  
  RasResult : Longint;  
begin  
  Result := 0;  

  //Load the RAS DLL  
  RasDLL := LoadLibrary('rasapi32.dll');  
  if RasDLL = 0 then exit;  

  try  
    RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');  
    if @RasEnums = nil then  
      raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');  

    Conns[1].dwSize := Sizeof (Conns[1]);  
    BufSize := SizeOf(Conns);  

    RasResult := RasEnums(@Conns, BufSize, NumConns);  

    If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;  
  finally  
    FreeLibrary(RasDLL);  
  end;  
end; 

Вообщем ситуация: нужно отправить созданное моей программой письмо по е-майлу независимо от юзера т.е. чтобы он не подозревал об отправке. Вот бы это на АПИ с примером!

 
unit Email;
interface
uses Windows, SusUtils, Classes;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;

function IsOnline: Boolean;

implementation
uses Mapi;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
var
  MapiMessage: TMapiMessage;
  MapiFileDesc: TMapiFileDesc;
  MapiRecipDesc: TMapiRecipDesc;
  i: integer;
  s: string;
begin
  with MapiRecipDesc do begin
      ulRecerved:= 0;
      ulRecipClass:= MAPI_TO;
      lpszName:= PChar(RecipName);
      lpszAddress:= PChar(RecipAddress);
      ulEIDSize:= 0;
      lpEntryID:= nil;
  end;

  with MapiFileDesc do begin
      ulReserved:= 0;
      flFlags:= 0;
      nPosition:= 0;
      lpszPathName:= PChar(Attachment);
      lpszFileName:= nil;
      lpFileType:= nil;
  end;

  with MapiMessage do begin
      ulReserved := 0;
      lpszSubject := nil;
      lpszNoteText := PChar(Subject);
      lpszMessageType := nil;
      lpszDateReceived := nil;
      lpszConversationID := nil;
      flFlags := 0;
      lpOriginator := nil;
      nRecipCount := 1;
      lpRecips := @MapiRecipDesc;
      if length(Attachment) > 0 then begin
          nFileCount:= 1;
          lpFiles := @MapiFileDesc;
      end else begin
          nFileCount:= 0;
          lpFiles:= nil;
      end;
    end;

  Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG 
or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;


function IsOnline: Boolean;
var
  RASConn: TRASConn;
  dwSize,dwCount: DWORD;
begin
  RASConns.dwSize:= SizeOf(TRASConn);
  dwSize:= SizeOf(RASConns);
  Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
  Result:= (Res = 0) and (dwCount > 0);
end;

end.

Скажите пожалуйста могу ли я из своей программы закрыть чужое приложение и как?

Кто-нибудь может кинуть мне пример программирования COM портов

unit TestRosh;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
  PortCombo: TComboBox;
    Label2: TLabel;
    BaudCombo: TComboBox;
    Label3: TLabel;
    ByteSizeCombo: TComboBox;
    Label4: TLabel;
    ParityCombo: TComboBox;
  Label5: TLabel;
    StopBitsCombo: TComboBox;
    Label6: TLabel;
    Memo1: TMemo;
    Edit1: TEdit;
  Button1: TButton;
    Memo2: TMemo;
    Edit2: TEdit;
    Label7: TLabel;
    Button2: TButton;
    Label8: TLabel;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure PortComboChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Memo1DblClick(Sender: TObject);
    end;

var
    Form1: TForm1;

implementation

{$R *.DFM}

uses Registry;

var
    hPort: THandle;

procedure TForm1.Memo1Change(Sender: TObject);
var
    i: Integer;
begin
    Edit1.Text := '';
    for i := 1 to Length(Memo1.Text) do
  Edit1.Text := Edit1.Text + Format('%x', [Ord(Memo1.Text[i])]) + ' '
end;

procedure TForm1.Memo2Change(Sender: TObject);
var
    i: Integer;
begin
    Edit2.Text := '';
    for i := 1 to Length(Memo2.Text) do
  Edit2.Text := Edit2.Text + Format('%x', [Ord(Memo2.Text[i])]) + ' '
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    S, D: array[0..127] of Char;
    actual_bytes: Integer;
    DCB: TDCB;
begin

    FillChar(S, 128, #0);
    FillChar(D, 128, #0);

    DCB.DCBlength := SizeOf(DCB);

    if not GetCommState(hPort, DCB) then begin
  ShowMessage('Can''t get port state: ' + IntToStr(GetLastError));
  Exit;
    end;

    try
  DCB.BaudRate := StrToInt(BaudCombo.Text);
    except
  BaudCombo.Text := IntToStr(DCB.BaudRate);
    end;

    try
  DCB.ByteSize := StrToInt(ByteSizeCombo.Text);
    except
  ByteSizeCombo.Text := IntToStr(DCB.ByteSize);
    end;

    if ParityCombo.ItemIndex > -1 then
  DCB.Parity := ParityCombo.ItemIndex
    else
  ParityCombo.ItemIndex := DCB.Parity;

    if StopBitsCombo.ItemIndex > -1 then
  DCB.StopBits := StopBitsCombo.ItemIndex
    else
  StopBitsCombo.ItemIndex := DCB.StopBits;

    if not SetCommState(hPort, DCB) then begin
  ShowMessage('Can''t set new port settings: ' + IntToStr(GetLastError));
  Exit;
    end;

  PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);

    StrPCopy(S, Memo1.Text);

    if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then begin
  ShowMessage('Can''t write to port: ' + IntToStr(GetLastError));
  Exit;
    end;

    if not ReadFile(hPort, D, StrToInt(Edit3.Text), actual_bytes, nil) then
  ShowMessage('Can''t read from port: ' + IntToStr(GetLastError))
    else
  ShowMessage('Read ' + IntToStr(actual_bytes) + ' bytes');
    Memo2.Text := D;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    with TRegistry.Create do begin
  OpenKey('\Software\MBEM\Rosh Shkila', True);
  WriteString('Port', PortCombo.Text);
  WriteString('Baud Rate', BaudCombo.Text);
  WriteString('Byte Size', ByteSizeCombo.Text);
  WriteString('Parity', IntToStr(ParityCombo.ItemIndex));
  WriteString('Stop Bits', IntToStr(StopBitsCombo.ItemIndex));
  Destroy;
    end;
    if not CloseHandle(hPort) then begin
  ShowMessage('Can''t close port: ' + IntToStr(GetLastError));
  Exit;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    hPort := CreateFile(PChar(PortCombo.Text),
              GENERIC_READ + GENERIC_WRITE,
              0,
              nil,
              OPEN_EXISTING,
              FILE_ATTRIBUTE_NORMAL,
              0);

    if hPort = INVALID_HANDLE_VALUE then
  ShowMessage('Can''t open ' + PortCombo.Text + ': ' + IntToStr(GetLastError))
    else
  Button2.Hide;
end;

procedure TForm1.PortComboChange(Sender: TObject);
begin
    FormDestroy(Sender);
    Button2.Show;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
    with TRegistry.Create do begin
  OpenKey('\Software\MBEM\Rosh Shkila', True);
  PortCombo.Text := ReadString('Port');
  BaudCombo.Text := ReadString('Baud Rate');
  ByteSizeCombo.Text := ReadString('Byte Size');
  ParityCombo.ItemIndex := StrToInt(ReadString('Parity'));
  StopBitsCombo.ItemIndex := StrToInt(ReadString('Stop Bits'));
  Destroy;
    end;
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
    Memo1.Lines.Clear;
    Memo2.Lines.Clear;
    Edit1.Text := '';
    Edit2.Text := '';
end;

end.

Var
  Printer: THandle;
  N      : Cardinal;
  C      : POverlapped;

begin
//Открываем порт принтера для записи
Printer := CreateFile(PChar('LPT1'),
           GENERIC_READ or GENERIC_WRITE,0,nil,
           OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);

//Печатаем слово 'Hello World';
WriteFile(Printer,'Hello World',11,N,c);
//Закрываем порт
CloseHandle(Printer);

Подскажите какие ХОРОШИЕ программы есть для создания ИНТАЛЯШЕК

Как получить сеpийные номеpа биоса и т.п.?

type
TRegistryRO = class (TRegistry)
   function OpenKeyRO (const Key: string): Boolean;
  end;
{ это уже ветхая история - был один глюк у D3}

implementation

uses WAPIInfo, Windows, SysUtils, StrUtils;

function TRegistryRO.OpenKeyRO (const Key: string): Boolean;
function IsRelative(const Value: string): Boolean;
  begin Result := not ((Value <> '') and (Value[1] = '\')) end;
var
  TempKey: HKey;
  S: string;
  Relative: Boolean;
begin
  S := Key;
  Relative := IsRelative(S);
  if not Relative then Delete(S, 1, 1);
  TempKey := 0;
    Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
      KEY_READ, TempKey) = ERROR_SUCCESS;
   if Result then begin
     if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
     ChangeKey(TempKey, S);
    end;
end;

function GetBIOSDate : string;
const
  BIOSDatePtr = $0ffff5;
  SystemKey = 'HARDWARE\DESCRIPTION\System';
  BiosDateParam = 'SystemBiosDate';
var
  p : pointer;
  s : string[128];
begin
  if OSisNT then begin
     with TRegistryRO.Create do try
       RootKey := HKEY_LOCAL_MACHINE;
       if OpenKeyRO (SystemKey) then begin
         s := ReadString (BiosDateParam);
        end;
       finally Free;
      end; { of try}
    end
   else try
      s[0] := #8;
      p := Pointer(BIOSDatePtr);
      Move (p^, s[1], 8);
     except FillChar (s[1], 8, '9');
    end; { of try}
  Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;

function GetVideoDate : string;
const
  VideoDatePtr = $0C0000;
  SystemKey = 'HARDWARE\DESCRIPTION\System';
  VideoDateParam = 'VideoBiosDate';
var
  p : pointer;
  s : string[255];
begin
  if OSisNT then begin
     with TRegistryRO.Create do try
       RootKey := HKEY_LOCAL_MACHINE;
       if OpenKeyRO (SystemKey)
        then s := ReadString (VideoDateParam)
        else s := 'NT/de/tected';
       finally Free;
      end; { of try}
    end
   else try
      s[0] := #255;
      p := Pointer(VideoDatePtr + 60); { первые $60 - строка CopyRight}
      Move (p^, s[1], 255);
      if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8)
       else begin
         p := Pointer(VideoDatePtr + 60 + 250);
         Move (p^, s[1], 255);
         if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8);
        end;
     except FillChar (s[1], 8, '9');
    end; { of try}
  Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;

unit WAPIInfo;

interface

uses Registry, SysUtils, Windows;

procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
function OSisNT : boolean;
procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
procedure GetMemInfo (var MemStr : string);

implementation

procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
var
  OSVerInfo : TOSVersionInfo;
  Reg : TRegistry;
  s : string;
begin
  OSVerInfo.dwOSVersionInfoSize := SizeOf (OSVerInfo);
  GetVersionEx (OSVerInfo);
  OSID := OSVerInfo.dwPlatformID;
  case OSID of
    VER_PLATFORM_WIN32S : OSStr := 'Windows 3+';
    VER_PLATFORM_WIN32_WINDOWS : OSStr := 'Windows 95+';
    VER_PLATFORM_WIN32_NT : begin
      OSStr := 'Windows NT';
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey ('SYSTEM\CurrentControlSet\Control\', False)
        then try
         s := Reg.ReadString ('ProductOptions')
        except s := ''
       end;
      if s = 'WINNT' then OSStr := OSStr + ' WorkStation'
      else if s = 'SERVERNT' then OSStr := OSStr + ' Server 3.5 & hi'
      else if s = 'LANMANNT' then OSStr := OSStr + ' Advanced server 3.1';
      Reg.Free;
     end;
   end;
  with OSVerInfo do OSStr := OSStr + Format (' %d.%d (выпуск %d)',
   [dwMajorVersion, dwMinorVersion, LoWord(dwBuildNumber)]);
end;

function OSisNT : boolean;
var
  s : string;
  i : DWORD;
begin
  GetOSVerInfo (i, s);
  Result := (i = VER_PLATFORM_WIN32_NT);
end;

procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
var SI : TSystemInfo;
begin
  GetSystemInfo (SI);
  CPUID := SI.dwProcessorType;
  case CPUID of
    386: CPUStr := '80386-совместимый процессор';
    486: CPUStr := '80486-совместимый процессор';
    586: CPUStr := 'Pentium-совместимый процессор';
    else CPUStr := 'Неизвестный процессор';
   end;
{  case SI.wProcessorArchitecture of
    PROCESSOR_ARCHITECTURE_INTEL: ;
    MIPS
    ALPHA
    PPC
    UNKNOWN
   end;}
end;

procedure GetMemInfo (var MemStr : string);
var MemInfo : TMemoryStatus;
begin
  MemInfo.dwLength := SizeOf (MemInfo);
  GlobalMemoryStatus (MemInfo);
  with MemInfo do MemStr := Format ('ОЗУ: %0.2f M (свободно %0.2f M)'#$d+
   ' Файл подкачки: %0.2f M (свободно: %0.2f M)'#$d,
   [(dwTotalPhys div 1024) / 1024,
    (dwAvailPhys div 1024) / 1024,
    (dwTotalPageFile div 1024) / 1024,
    (dwAvailPageFile div 1024) / 1024]);
end;

end.

Как вызвать процедуру из чужого ЕХЕ файла

Var
  vMyServer : OLEVariant;
Begin
  vMyServer := CreateOLEObject("имя CLSID");
  vMyServer.Имя_метода(...);
  ...
  vMyServer := Null;
End;

Можно-ли из Дельфей вызвать Outlook и автоматически послать месаги

Как можно подключить dll`ку и как использовать её функции...

uses Windows, ...;
type

  TTimeRec = record
    Second: Integer;
    Minute: Integer;
    Hour: Integer;
  end;

  TGetTime = procedure(var Time: TTimeRec);

  THandle = Integer;

var

  Time: TTimeRec;
  Handle: THandle;
  GetTime: TGetTime;
  ...
begin
  Handle := LoadLibrary('DATETIME.DLL');
  if Handle <> 0 then
  begin
    @GetTime := GetProcAddress(Handle, 'GetTime');
    if @GetTime <> nil then
    begin
      GetTime(Time);
      with Time do
        WriteLn('The time is ', Hour, ':', Minute, ':', Second);
    end;
    FreeLibrary(Handle);
  end;

end;

dialup и delphi

Доступ к памяти чужой программы

TWebBrowser

Как зарегистрировать свое расшерения для файлов? Т.е. чтобы при щелчке по такому файлу вызывалась моя программа.

//Use the registry to register your own filetype. 

uses registry; 

procedure TForm1.RegisterFileType(prefix:String; exepfad:String); 
var 
  reg:TRegistry; 
begin 
  reg:=TRegistry.Create; 
  reg.RootKey:=HKEY_CLASSES_ROOT; 
  //create a new key  --> .pci 
  reg.OpenKey('.'+prefix,True); 
  //create a new value for this key --> pcifile 
  reg.WriteString('',prefix+'file'); 
  reg.CloseKey; 
  //create a new key --> pcifile 
  reg.CreateKey(prefix+'file'); 
  //create a new key pcifile\DefaultIcon 
  reg.OpenKey(prefix+'file\DefaultIcon',True); 
  //and create a value where the icon is stored --> c:\project1.exe,0 
  reg.WriteString('',exepfad+',0'); 
  reg.CloseKey; 
  reg.OpenKey(prefix+'file\shell\open\command',True); 
  //create value where exefile is stored --> c:\project1.exe "%1" 
  reg.WriteString('',exepfad+' "%1"'); 
  reg.CloseKey; 
  reg.Free; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  RegisterFileType('pci','c:\project1.exe'); 
end; 

Принтер в Delphi

Var FileOut : TextFile;
    filename : String [128];
....
Filename:='PRN';
AssignFile(Fileout,Filename);
...
Write(FileOut,Chr(27)+'@');
Str1:=AnToAs(chr(27)+'G'+'Double'+chr(27)+'H');
Writeln(FileOut,Str1);
...

{преобразование Ansi to Ascii}
function AnToAs(s: String) : String;
Var i,kod : Integer;
begin
 Result:=s;
 for i:=1 to length(s) do
 begin
  kod:=Ord(s[i]);
  if  kod < 13 then Result[i]:=' ';
  if ( kod>=192) and ( kod<=239) then 
     Result[i]:=Chr(kod-64);
  if ( kod>=240) and ( kod<=255) then 
     Result[i]:=Chr(kod-16);
  if kod=168 then  Result[i]:=Chr(240);
  if kod=184 then  Result[i]:=Chr(241);
 end;
end;

Как програмно перезагрузить Windows?

TTimer работает не достаточно точно. Как получить более высокую точность?

Как получить имена свободных com портов?

//Show the names of available comm ports (com1, com2, ...) 

//Used registry key: hkey_local_machine\hardware\devicemap\serialcomm 

uses registry; 

... 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  reg : TRegistry; 
  st : TStrings; 
  i : integer; 
begin 
  reg := TRegistry.Create; 
  reg.RootKey := HKEY_LOCAL_MACHINE; 
  reg.OpenKey('hardware\devicemap\serialcomm',false); 
  st := TStringList.Create; 
  reg.GetValueNames(st); 
  for i := 0 to st.Count -1 do begin 
    Memo1.Lines.Add(reg.ReadString(st.Strings[i])); 
  end; 
  st.Free; 
  reg.CloseKey; 
  reg.free; 
end; 

Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?

Курсор мыши за границами активной формы.

Как послать message всем?

procedure TForm1.DefaultHandler(var Message);
begin
  with TMessage(Message) do
  begin
    if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM)  else
    Inherited DefaultHandler(Message);
  end;
end;

Работа с принтером.

Procedure TForm1.Button1Click(Sender: TObject);
Begin
 With Printer do Begin
  BeginDoc; { Начало печати }
  Canvas.Font:=label1.font; { Задали шрифт }
  Canvas.TextOut(100,100,'Это тест принтера !!!'); { Печатаем текст }
  EndDoc; { Конец печати }
 end;
end;

Особенности работы с TPrinter

1. После команды BeginDoc шрифт у Canvas принтера сбрасывается и его необходимо задавать заново
2. Все координаты даны в пикселах, а для нормальной работы необходимы миллиметры (по двум очевидным причинам: очень трудно произвести разметку страницы в пикселах (особенно если необходима точность), и , главное, при изменении разрешающей способности принтера будет изменяться число точек на дюйм, и все координаты "поедут".
3. У TPrinter информация о принтере, по видимому, определяются один раз - в момент запуска программы (или смены принтера). Поэтому изменение настроек принтера в процессе работы программы может привести к некорректной работе, например, неправильной печать шрифтов True Type.
Определение параметров принтера через API
Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle.
Далее вызывается функция API (unit WinProcs) : GetDevice(Handle:HDC; Index:integer):integer;
Index - код параметра, который необходимо вернуть.
Для Index существует ряд констант :
DriverVersion - вернуть версию драйвера
Texnology - Технология вывода, их много, основные
 dt_Plotter - плоттер
 dt_RasPrinter - растровый принтер
 dt_Display - дисплей
HorzSize - Горизонтальный размер листа (в мм)
VertSize - Вертикальный размер листа (в мм)
HorzRes - Горизонтальный размер листа (в пикселах)
VertRes - Вертикальный размер листа (в пикселах)
LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм)
LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм)
Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все. Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера. Пример таких функций:

Procedure TForm1.GetPrinterInfo; { Получить информацию о принтере }
begin
  PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX);
  PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY);
end;

Function TForm1.PrinterCoordX(x:integer):integer; { переводит координаты из мм в пиксели }
begin
 PrinterCoordX:=round(PixelsX/25.4*x);
end;

Function TForm1.PrinterCoordY(Y:integer):integer; { переводит координаты из мм в пиксели }
begin
 PrinterCoordY:=round(PixelsY/25.4*Y);
end;
---------------------------------
GetPrinterInfo;
Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),
 'Этот текст печатается с отступом 30 мм от левого края и '+
 '55 мм от верха при любом разрешении принтера');

Как стереть ехе-файл во время его исполнения?

     uses
       Registry;

     procedure TForm1.Button1Click(Sender: TObject);
     var
       reg: TRegistry;

     begin
       reg := TRegistry.Create;

       with reg do begin
     RootKey := HKEY_LOCAL_MACHINE;
     LazyWrite := false;
     OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce',
             false);
     WriteString('Delete Me!','command.com /c del FILENAME.EXT');
     CloseKey;
     free;
       end;
     end;

Как получить дескриптор окна другого приложения и сделать его активным?

 type
   PFindWindowStruct = ^TFindWindowStruct;
   TFindWindowStruct = record
     Caption : string;
     ClassName : string;
     WindowHandle : THandle;
   end;

 function EnumWindowsProc(hWindow : hWnd;
                          lParam  : LongInt) : Bool
 {$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
 var
   lpBuffer : PChar;
   WindowCaptionFound : bool;
   ClassNameFound : bool;

 begin
   GetMem(lpBuffer, 255);
   Result := True;
   WindowCaptionFound := False;
   ClassNameFound := False;

   try
     if GetWindowText(hWindow, lpBuffer, 255) > 0 then
       if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0
        then WindowCaptionFound := true;

     if PFindWindowStruct(lParam).ClassName = '' then
       ClassNameFound := True else
         if GetClassName(hWindow, lpBuffer, 255) > 0 then
           if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer))
            > 0 then ClassNameFound := True;

     if (WindowCaptionFound and ClassNameFound) then begin
       PFindWindowStruct(lParam).WindowHandle := hWindow;
       Result := False;
     end;

   finally
     FreeMem(lpBuffer, sizeof(lpBuffer^));
   end;
 end;

 function FindAWindow(Caption : string;
                      ClassName : string) : THandle;
 var
   WindowInfo : TFindWindowStruct;

 begin
   with WindowInfo do begin
     Caption := Caption;
     ClassName := ClassName;
     WindowHandle := 0;
     EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
     FindAWindow := WindowHandle;
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   TheWindowHandle : THandle;
 begin
   TheWindowHandle := FindAWindow('Netscape - ', '');
   if TheWindowHandle = 0 then
     ShowMessage('Window Not Found!') else
     BringWindowToTop(TheWindowHandle);
 end;

В своей программе я запускаю с помощью CreateProcess приложение (например Notepad), мне необходимо передать Message в окно этого приложения.

Как скопировать директорию

procedure TForm1.Button2Click(Sender: TObject);
var
  OpStruc: TSHFileOpStruct;
  frombuf, tobuf: Array [0..128] of Char;
begin
  FillChar( frombuf, Sizeof(frombuf), 0 );
  FillChar( tobuf, Sizeof(tobuf), 0 );
  StrPCopy( frombuf, 'd:\brief\*.*' );
  StrPCopy( tobuf, 'd:\temp\brief' );
  with OpStruc do begin
    Wnd := Handle;
    wFunc := FO_COPY;
    pFrom := @frombuf;
    pTo := @tobuf;
    fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted := False;
    hNameMappings := Nil;
    lpszProgressTitle := Nil;
  end;
  ShFileOperation( OpStruc );
end;