OpenFileMapping 的一个问题

Question

//程序1
CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TSharedMemData), 'test');
//程序2
OpenFileMapping(FILE_MAP_WRITE, False, 'test');
//==========================================================================================
//程序1(这代码在一个线程里)
// MemData 为程序全局变量 
// MemData:=OpenFileMapping(FILE_MAP_WRITE, False, 'test');
function (name:string):TData;
begin
  
  MemData.Str1:='我靠';
  MemData.Status:=2;//标记为保存
  while (True) do begin
    if MemData.Status = 22 then begin//保存OK标记
      move(MemData.Data,result,sizeof(TData));
      MemData.Status := 0;
      break;
    end;
  end;
end;程序2(这代码在一个Timer事件里间隔 1毫秒)
// MemData 为程序全局变量 
// MemData:=OpenFileMapping(FILE_MAP_WRITE, False, 'test');
var
MemData:TSharedMemData;
tmpData:TData;
begin
  MemData:=OpenFileMapping(FILE_MAP_WRITE, False, 'test');
  if MemData.Status = 2 then begin
    move(MemData.Data,tmpData,sizeof(TData));  
    if save(Data.Str1,tmpData) then MemData.Status:=22; 
  end;
end;
function save(name:string;Data:TData):boolena;
var
SqlTiaoJian:string;//SQL条件
begin
  SqlTiaoJian := copy(name,1,length(name));//直接 := 也行 只是出了这个问题怀疑是这个原因所以先Copy
  fillchar(Data,sizeof(TData),0);
  SqlStr := 'SELECT * FROM TAB1 WHERE (Name=' + '''' + SqlTiaoJian+ '''';
      ADOQueryLoad.SQL.Add(Sqlstr);
      ADOQueryLoad.Active := True;
  ...........................
end;
执行到 save SqlTiaoJian 总是变'' 不知何解

Answer 1

再说下
function save(name:string;Data:TData):boolena;
name传进来就是 ''
function (name:string):TData;
begin
  
  MemData.Str1:='我靠';
  MemData.Status:=2;//标记为保存
  Sleep(1000);//这样也没用
  while (True) do begin
    if MemData.Status = 22 then begin//保存OK标记
      move(MemData.Data,result,sizeof(TData));
      MemData.Status := 0;
      break;
    end;
  end;
end;

Answer 2

程序2(这代码在一个Timer事件里间隔 1毫秒)
// MemData 为程序全局变量 你加个线程同步试下 

Answer 3

为什么要线程呢?
程序2  什么都不做的 就只有个 Time 不停的循环检测

Answer 4

OpenFileMapping只是返回一个文件的句柄而已,要实现文件映射还要调用MapViewOfFile,
Var
  PMemData:TSharedMemData;
begin
  ...
  PMemData := MapViewOfFile(MemData,FILE_MAP_ALL_ACCESS,0,0,0);
  

Answer 5

下面代码你参考一下,或者到网上找一个完全的例子来参考一下,你那样写不行var
  Form1: TForm1;
  hMap: THandle;
  aUserMsg: TMsg;
  PUserMsg: PMsg;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  hMap:=CreateFileMapping($FFFFFFFF,
                           nil,
                           PAGE_READWRITE,
                           0,
                           SizeOf(TMsg),
                           'MsgReceptor');  if hMap=0 then
    raise Exception.Create('Error while create file')
  else
    label1.Caption := 'Memory mapping has created.';
  PUserMsg:=MapViewOfFile(hMap,FILE_MAP_ALL_ACCESS,0,0,0);
  if PUserMsg = nil then
  begin
    CloseHandle(hMap);
    ShowMessage('Can''t view of Memory map');
    Application.Terminate;
    exit;
  end;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  if PUserMsg <> nil then
    UnmapViewOfFile(PUserMsg);
  if hMap<>0 then
    CloseHandle(hMap);
end;procedure UserMemoryMapping;
var
  hnd: THandle;
begin
   hnd:=OpenFileMapping(FILE_MAP_WRITE,False,'MsgReceptor');
   if hnd<>0 then
   begin
     PUserMsg:=MapViewOfFile(hnd,FILE_MAP_WRITE,0,0,0);
     PUserMsg^.hwnd := Form1.Edit2.Handle;
     SendMessage(PUserMsg.hwnd,PUserMsg.message,PUserMsg.wParam,PUserMsg.lParam);
     UnmapViewOfFile(PUserMsg);
     CloseHandle(hnd);
   end;
end;procedure TForm1.SetMessage;
var
  s:String;
  pc:PChar;
begin
  s := 'TEst';
  pc := PChar(s);
  with aUserMsg do
  begin
    hwnd := Edit1.Handle;
    message := WM_SETTEXT;
    wParam := 0;
    lParam := Integer(pc);
    time := 0;
    pt := Point(0,0);
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  SetMessage;
  CopyMemory(PUserMsg,@aUserMsg,SizeOf(TMsg));
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  UserMemoryMapping;
end;end.

Answer 6

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,Smem;type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  MemData:pTSharedMemData=nil;
implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  MemData :=Smem.initializeSharedMemData;
  if MemData =nil then ShowMessage('Nil');
end;
function loadForSQL(name:string;Data:pTData):Integer;
var
  tmpName:string;
begin
  Form1.Caption := name+':'+inttostr(Random(99999));
  //ShowMessage(name);//问题就在这有时候它是空
  Result := -1;
  tmpName:= Copy(name,1,Length(name));
  //注意name 是Data.sName 所以我担心FillChar 会把他清空所以copy
  FillChar(Data^,SizeOf(TData),0);
  //从SQL 读数据到 Data............  //读完了返回 22
  Result := 22;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
  i:Integer;
  SaveData:pTSaveData;
begin
  for i := 0 to 99 do begin
    SaveData:[email protected][i];
    if SaveData.Status = 2 then   //
      SaveData.Status:=loadForSQL(SaveData.Data.sName,@SaveData.Data);
  end;
end;end.unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Smem;type  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public  end;
  TLoadEngine = class(TThread)  protected
    procedure Execute; override;
  end;
  procedure Load(Name:string;LoadData:pTData);
var
  Form1: TForm1;
  MemData:pTSharedMemData=nil;
  LoadEngine:TLoadEngine;
implementation{$R *.dfm}
procedure TLoadEngine.Execute;
var
 Data:pTData;
begin
  // for list....
  New(Data);
  Load('王清',Data);
  Dispose(Data);
  Sleep(10);//实际代码中没这个
  //end ....
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  MemData :=initializeSharedMemData;
  if MemData =nil then ShowMessage('Nil');
  LoadEngine:=TLoadEngine.Create(False);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  LoadEngine.Free;
end;
procedure Load(Name:string;LoadData:pTData);
var
  dwTimeOutTick: LongWord;
  i:Integer;
  Data:pTSaveData;
begin
    Data:=nil;
    for i := 0 to 99 do begin
      if MemData.Data[i].Status = 0 then
      begin
        Data :[email protected][i];
        Break;
      end;
    end;
    if Data = nil then begin
      ShowMessage('读取失败,无空闲');
      Exit;
    end;
      Data.Data.sName := Name;
      ShowMessage('读取::'+Data.Data.sName);
      //Sleep(1000);
      Data.Status := 2;
      dwTimeOutTick := GetTickCount();
      while (True) do begin
        if (GetTickCount - dwTimeOutTick) > 5000 then begin
          ShowMessage('读取失败超时');
          break;
        end;
        if Data.Status >= 0 then begin
          if Data.Status = 22 then
          begin
            //if HumanData. = sCharName then
            //begin
              Move(Data.Data, LoadData^, sizeof(TData));
            {end
            else
              Result := False; }
            Data.Status:=0;
            Break;
          end;
        end else begin
          ShowMessage('读取失败 Status');
          break;
        end;
        Sleep(1);
      end;
end;
end.