Formular geöffnet ist

[KodeZwerg]

Ein enorm simples Beispiel findest Du hier, da geht es um die WinApi LockFile() und UnLockFile().

Falls die Quelle verloren geht, hier der Client Quelltext:

Delphi-Quellcode:

unit Unit1_Check;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label3: TLabel;
    edtFileName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure StatusBar1DblClick(Sender: TObject);
  private
    { Private declarations }
    _FileStream:TFileStream;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Err:Boolean;
  i:Integer;
  FileName:String;
begin

  FileName := edtFileName.Text;
  Self.ListBox1.Color := clYellow;
  Self.Repaint;
  // proteccion
  try

    // Existe el fichero de bloqueo ?
    if not FileExists(FileName) then begin
      // Crear el fichero de bloqueo
      Self._FileStream := TFileStream.Create(FileName, fmCreate);
      Self._FileStream.Free;
    end;

    //  Abrirlo
    Self._FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
    Self.ListBox1.Items.Clear;

    // Buscar en todas las posiciones
    for i := 0 to 255 do begin

      // intentar bloquear
      Err := not Windows.LockFile(Self._FileStream.Handle, i, 0, 1, 0);

      // Está bloqueado
      if (Err) then begin
        Self.ListBox1.Items.Add (IntToStr(i));
      end
      else begin
        // Lo desbloqueo
        Windows.UnLockFile(Self._FileStream.Handle, i, 0, 1, 0);
      end;

    end;
  finally
    Self.ListBox1.Color := clWindow;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Self.Left := 0;
  Self.Top := 0;
end;

procedure TForm1.StatusBar1DblClick(Sender: TObject);
begin
    ShellExecute(Handle,
             'open',
             'http://neftali.clubdelphi.com/',
             nil,
             nil,
             SW_SHOW);
end;

end.

und hier der Server Quelltext:

Delphi-Quellcode:

unit Unit1Ej;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, SHEllAPI;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    edtIP: TEdit;
    Label3: TLabel;
    edtFileName: TEdit;
    StatusBar1: TStatusBar;
    procedure FormShow(Sender: TObject);
    procedure StatusBar1Click(Sender: TObject);
  private
    { Private declarations }

    _FileStream:TFileStream;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
var
  Err:Boolean;
  i, cont:Integer;
  FileName:String;
begin

  // Obtiene un número entre 1 y 255
  Randomize;
  i := Random(255) + 1;
  edtIP.Text := IntToStr(i);


  Self.Left := Screen.Width - Self.Width;
  Self.Top := i;
  Self.Caption := Self.Caption + '  -  ' + edtIP.Text;

  FileName := edtFileName.Text;

  // Existe el fichero de bloqueo ?
  if not FileExists(FileName) then begin
    // Crear el fichero de bloqueo
    Self._FileStream := TFileStream.Create(FileName, fmCreate);
    Self._FileStream.Free;
  end;

  //  Abrirlo
  Self._FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);

  Err := True;
  cont := 0;

  // Varios intentos
  while (Err) and (cont < 5) do begin
    sleep(300);
    // Al entrar bloqueamos el byte correspondiente al número
    Err := not Windows.LockFile(Self._FileStream.Handle, i, 0, 1, 0);
    cont := cont + 1;
  end;

  if Err then begin
    MessageDlg('No se ha podido conectar devido a que no ha podido bloquear el byte: ' + IntToStr(i), mtError, [mbOK], 0);
    Application.Terminate;
  end;

end;

procedure TForm1.StatusBar1Click(Sender: TObject);
begin
    ShellExecute(Handle,
             'open',
             'http://neftali.clubdelphi.com/',
             nil,
             nil,
             SW_SHOW);
end;

end.