API - compartilhando arquivo virtual entre programas windows usando o CreateMapFile

{*******************************************************}

{                                                       }

{     Exemplo de CreateMapFile - Arquivo Virtual        }

{     e de como comunicar para outro programa           }

{     MAIS ABAIXO ESTA UNIT DO CLIENT                   }

{                                                       }

{     Coloque: 2 edits, 1 Listbox, 2 buttns             }

{                                                       }

{                                                       }

{*******************************************************}

unit ServidorUnit;

interface

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

const

  WM_MENSAGEM  = WM_USER + 1;  // mensagem para enviar arquivo

  ARQUIVO      = 'ACME.SHR';   // nome do arquivo

  MAXREGISTROS = 1024;         // número maximo de registros

type                           // declara-se um tipo a ser usado na comunicacao

  TMyFile = record

    Codigo: Integer;

    Nome  : string[255];

  end;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Edit1: TEdit;

    Edit2: TEdit;

    ListBox1: TListBox;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Button2Click(Sender: TObject);

  private

    HArquivo : THandle;       // Handle do arquivo

    PArquivo : Pointer;       // Ponteiro para o arquivo

    IRegistro: Cardinal;      // indice do registro

    // procedures para comunicacao

    function TransmitirArquivo: Boolean;

    procedure AbreArquivo;

    procedure InserirRegistros;

    procedure FecharArquivo;

    procedure FecharReceptor;

  public

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

////////////////////////////////////////////// FUNCOES INTERNAS

procedure TForm1.AbreArquivo;

begin

  // abre um arquivo virtual

  IRegistro := 0;

  {

   $FFFFFFFF      = arquivo virtual

   nil            = Seguranca, nil = nao pode ser usado por objetos filhos

   PAGE_READWRITE = leitura e gravacao

   0              = Para arquivos menores que 4Gb deve ser ZERO

   Formula        = TamanhoArquivo * Num.Registros

   NomeArquivo    = Para o programa client

  }

  HArquivo  := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TMyFile) * MAXREGISTROS, ARQUIVO);

  if HArquivo = 0 then

  begin

    ShowMessage('Falha');

    Exit;

  end;

  PArquivo := MapViewOfFile(HArquivo, FILE_MAP_WRITE, 0, 0, SizeOf(TMyFile) * MAXREGISTROS);

end;

procedure TForm1.FecharArquivo;

begin

  UnmapViewOfFile(PArquivo);

  CloseHandle(HArquivo);

end;

procedure TForm1.FecharReceptor;

var

  H: THandle;

begin

  H := FindWindow(nil, 'FormCliente');

  if H <> 0 then

    SendMessage(H, WM_CLOSE, 0, 0);

end;

procedure TForm1.InserirRegistros;

var

  PTemp   : ^TMyFile;

  iOffSet : Cardinal;

begin

  Inc(IRegistro);

  if IRegistro > MAXREGISTROS then

  begin

    ShowMessage('O arquivo está cheio');

    Exit;

  end;

  // o OffSet é a posicao na memório do "proximo" registro

  iOffSet := SizeOf(TMyFile) * (IRegistro - 1);

  // PTemp aponta para o ponteiro do arquivo + OffSet = posicao a ser inserida na memoria

  PTemp   := Pointer(Cardinal(PArquivo) + iOffSet);

  // Aqui passa os valores...

  PTemp^.Codigo := StrToIntDef(Edit1.Text,0);

  PTemp^.Nome   := Edit2.Text;

  ListBox1.Items.Add( Edit1.Text + ' - '+ Edit2.Text);

end;

function TForm1.TransmitirArquivo: Boolean;

var

  H: THandle;

begin

  Edit1.Text := '99999';

  Edit2.Text := 'FIM';

  InserirRegistros;

  H := FindWindow(nil, 'FormCliente');

  if H <> 0 then

    SendMessage(H, WM_MENSAGEM, 0, 0);

  Result := H <> 0;

end;

/////////////////////////////////////////////// FORM/BOTOES

procedure TForm1.FormCreate(Sender: TObject);

begin

  AbreArquivo;

  // abre o client

  WinExec('project22.exe', sw_shownormal);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  InserirRegistros;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FecharArquivo;

  FecharReceptor;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  if not TransmitirArquivo then

  begin

    ShowMessage('Arquivo não transmitido');

    Exit;

  end;

  FecharArquivo;

  AbreArquivo;

  ShowMessage('Arquivo transmitido');

  ListBox1.Clear;

  Edit1.Clear;

  Edit2.Clear;

end;

end.

{*******************************************************}

{                                                       }

{     UNIT CLIENT                                       }

{     1 memo e 1 label                                  }

{                                                       }

{*******************************************************}

unit ClienteUnit;

interface

uses Windows, Messages, Forms, SysUtils, Controls, StdCtrls, Classes, Unit1, Dialogs;

type

  TClientForm = class(TForm)

    Memo1: TMemo;

    Label1: TLabel;

  private

    procedure ReceberMensagem(var Msg: TMessage); message WM_MENSAGEM;

  public

  end;

var

  ClientForm: TClientForm;

implementation

{$R *.dfm}

procedure TClientForm.ReceberMensagem(var Msg: TMessage);

var

  HArquivo : THandle;       // Handle do arquivo

  PArquivo : Pointer;       // Ponteiro para o arquivo

  IRegistro: Cardinal;      // indice do registro

  PTemp    : ^TMyFile;

  iOffSet  : Cardinal;

begin

  Label1.Caption := 'RECEBI!';

  Memo1.Lines.Clear;

  // abre o arquivo

  {

   FILE_MAP_READ = somente leitura

   False         = ninguem herda este (é exclusivo)

   ARQUIVO       = nome

  }

  HArquivo := OpenFileMapping(FILE_MAP_READ, False, ARQUIVO);

  if HArquivo = 0 then

  begin

    ShowMessage('Falho!');

    Exit;

  end;

  // Pega o endereco

  PArquivo := MapViewOfFile(HArquivo, FILE_MAP_READ, 0, 0, SizeOf(TMyFile) * MAXREGISTROS);

  // Ler o arquivo até o fim

  IRegistro := 0;

  while IRegistro < MAXREGISTROS do

  begin

    Inc(IRegistro);

    // calcula o "andress" do registro

    iOffSet := SizeOf(TMyFile) * (IRegistro - 1);

    PTemp   := Pointer(Cardinal(PArquivo) + iOffSet);

    // Tá no fim?

    if Trim(PTemp^.Nome) = 'FIM' then

      IRegistro := MAXREGISTROS + 1

    else

      Memo1.Lines.Add(IntToStr(PTemp^.Codigo) + ' - ' + PTemp^.Nome);

  end;

  // fecha tudo - passa regua

  UnmapViewOfFile(PArquivo);

  CloseHandle(HArquivo);

end;

end.