Разное

         Как заблокировать повторный запуск программы

         Как сделать shareware программу

         Спрятать курсор мыши

         Скопировать все файлы вместе с подкаталогами

         Иммитация нажатия клавиш

         Включение любого файла в EXEшник

         Аналог функции DELAY (задержка)

         Преобразование строки из DOS кодировки в Windows и обратно


Как заблокировать повторный запуск программы

//Под управлением Delphi не работает - только автономно!! 

procedure TForm1.FormCreate(Sender: TObject);
var Wnd : hWnd;
    s: PСhar;
    buff: array [0..127] of сhar;
    copdata: TCopyDataStruct;
begin
  Wnd := GetWindow(Handle, gw_HWndFirst);
  while Wnd <> 0 do begin
    {Если не собственное и не дочернее окно}
    if (Wnd <> Application.Handle) and (GetWindow(Wnd, gw_Owner) = 0) then begin
      GetWindowText(Wnd, buff, sizeof(buff));
      {Если заголовок совпадает, то...}
      if StrPas(buff) = Application.Title then //Поторный запуск
        // ***** Действие при повторном запуске *******
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
end;

Как сделать shareware программу

//Данный пример запускается только один раз за сессию Windows.

procedure TForm1.FormCreate(Sender: TObject);
var CRLF : string;
begin
  if GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then
    GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')
  else begin
    CRLF := #10 + #13;
    ShowMessage('This version may only be run '+
            'once for every Windows Session.'+CRLF+
            'To run this program again, you '+
            'need to restart Windows, or better yet:' + CRLF +
            'REGISTER !!');
    Halt;
  end;
end;

Спрятать курсор мыши

//Выключение курсора
procedure TForm1.Button1Click(Sender: TObject);
var CState: integer;
begin
  CState:= ShowCursor(True);
  while Cstate >= 0 do 
    Cstate := ShowCursor(False);
end;

//Включение курсора
procedure TForm1.Button2Click(Sender: TObject);
var Cstate : integer;
begin
  Cstate := ShowCursor(True);
  while CState<0 do 
    CState:=ShowCursor(True);
bnd;

Скопировать все файлы вместе с подкаталогами

uses ShellApi;

procedure TForm1.Button1Click(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, 'h:\hook\*.*');
  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;

Иммитация нажатия клавиш

procedure TForm1.Timer1Timer(Sender: TObject);
var x,y: integer;
begin
  x:=random(300);
  y:=random(200);
  SendMessage(Handle,WM_LBUTTONDOWN,MK_LBUTTON,x+y shl 16);
  SendMessage(Handle,WM_LBUTTONUP,MK_LBUTTON,x+y shl 16);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
           Shift: TShiftState; X, Y: Integer);
begin
  Label1.Caption:=IntToStr(x)+','+IntToStr(y);
  Label1.Left:=x;
  Label1.Top:=y;
end;

Включение любого файла в EXEшник

Создать файл
nn.rc содержащий строчку

CHECK AVI "340.avi" или
CHECK WAV "340.avi"

Затем компилировать с помощью brcc32.exe в ресурс (RES).
Подключить в программе {$R nn.res}


Аналог функции DELAY (задержка)

procedure MyDelay(msecs: integer);
var FirstTickCount: longint;
begin
  FirstTickCount:=GetTickCount;
  repeat
    Application.ProcessMessages;
  until ((GetTickCount-FirstTickCount) >= msecs);
end;

Преобразование строки из DOS кодировки в Windows и обратно

    Для этого надо воспользоватся файлом Ansi.pas. В нем описаны две функции: _OTA - перекодировка из DOS в Windows и _ATO - наоборот.

main_back.gif (3425 bytes)

Используются технологии uCoz