msgclient.pas

来自「群星医药系统源码」· PAS 代码 · 共 588 行 · 第 1/2 页

    List :TListItem;
    ListTitle :TStrings;
begin
  ListTitle := TStringList.Create;
  AppPath := ExtractFilePath(Application.ExeName);
  if not DirectoryExists(AppPath+'Temp\') then
    MkDir(AppPath+'Temp\');
  AppName := AppPath+'Temp\~'+DateToStr(Now)+'.Tmp';
  OldMsg := TiniFile.Create(AppName);
  OldMsg.ReadSections(ListTitle);
  Row:=ListTitle.Count-1;
  if Row<0 then
  begin
    FmMsgClient.BtnNextMsg.Enabled := False;
    OldMsg.Free;
    Exit;
  end else begin
    FmMsgClient.BtnNextMsg.Enabled := True;
  end;
  Row := 0;
  FmMsgClient.OnceBlock.ModuleID := OldMsg.ReadString(ListTitle[Row],'ModuleID','');
  FmMsgClient.OnceBlock.BillNo := OldMsg.ReadString(ListTitle[Row],'BillNo','');
  FmMsgClient.OnceBlock.Command := StrToBool(OldMsg.ReadString(ListTitle[Row],'Command','0'));
  FmMsgClient.lblSrcinfo.Caption := ListTitle[Row];
  FmMsgClient.MmoInfo.Clear;
  FmMsgClient.MmoInfo.Lines.Add(OldMsg.ReadString(ListTitle[Row],'Msg',''));
  OldMsg.EraseSection(ListTitle[Row]);
  OldMsg.Free;
  ListTitle.Free;
  if FmMsgClient.OnceBlock.Command then
    FmMsgClient.BtnShowBill.Enabled := True
  else FmMsgClient.BtnShowBill.Enabled := False;
end;

procedure TClientHandleThread.HandleInput; //处理读取的消息
var List:TListItem;
    Row :Integer;
    b1: Boolean;
begin
  if CB.Msg='_GetMsg$GetMsg_' then Exit; //如果读出来的消息是客户端自己写的（即没有消息）
  if CB.Msg='Login...' then
  begin
    b1 := true;
    CB.DestId := ServerMsg;
    CB.Msg := '登录成功！'
  end;
  if Not(FmMsgClient.Logined) then  //用户列表处理
  begin
    FmMsgClient.CbxUsrList.Clear;
    For Row:=0 to CB.UserList.Count-1 do
      FmMsgClient.CbxUsrList.Items.Add(Cb.UserList.User[Row]);
    FmMsgClient.CbxUsrList.ItemIndex := 0;
  end;
  FmMsgClient.Logined := True;
  if Trim(CB.DestId)<>'' then
  begin
    b1 := true;
    FmMsgClient.SaveOldMsg(CB);
    If (cb.UserId=cb.DestId) Or (cb.DestId=ServerMsg) Then
      FmMsgClient.SaveTempMsg(CB);
  End;
  if b1 then
    PostMessage(Application.MainForm.Handle, WM_OnChildFormAsk, FmMsgClient.Handle, 1);
end;

procedure TClientHandleThread.Execute;
begin
  while not Terminated do
  begin
    if (FmMsgClient.Client=nil) or not FmMsgClient.Client.Connected then
      Terminate
    else
    try
      FmMsgClient.Client.ReadBuffer(CB, SizeOf (CB)); //读取服务器消息
      Synchronize(HandleInput);
    except
    end;
  end;
end;

procedure TFmMsgClient.Connection;
begin
  try
    Client.Connect(1000);
    ClientHandleThread := TClientHandleThread.Create(True);
    ClientHandleThread.FreeOnTerminate:=True;
    ClientHandleThread.Resume;
  except
  end;
end;

procedure TFmMsgClient.FormCreate(Sender: TObject);
var IniFile: TIniFile;
begin
  TmpMsg := TStringList.Create;
  IFmMain := Application.MainForm as IMainForm;
{因为IP保存在数据库中，改为由FmMainEx单元传入MsgServerIP的值，不从INI文件读取
  IniFile := TIniFile.Create(IFmMain.IniFileName);
  MsgServerIP := IniFile.ReadString('MsgServer','IP','');
  IniFile.Free;}
  if MsgServerIP='' then
  begin
//    MessageBox(handle,'请设置你的消息服务器...','提示',MB_OK);
    bUseServerMsg :=False;
    Exit;
  End;
  bUseServerMsg := True;
  Client.Host := MsgServerIP;
  Logined := False;
  Loginout:= false;
end;

procedure TFmMsgClient.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if (LoginOut) Or (Not(bUseServerMsg)) then
  begin
    ReadMsg.Enabled := False;
    Action := caFree;
  end else begin
    Action := caHide;
  end;
end;

procedure TFmMsgClient.FormDestroy(Sender: TObject);
begin
  TmpMsg.Free;
end;

procedure TFmMsgClient.UserLogin;
var CommBlock :TCommBlock;
begin
  If Not(bUseServerMsg) Then Exit;
  try
    Connection;
  Except
    Exit;
  end;
  CommBlock.AccountName := LblAccount.Caption;
  CommBlock.UserId := lblUser.Caption;
  commBlock.UserIP := ThisIP.LocalIP;
  CommBlock.DestId := lblUser.Caption;
  CommBlock.Online := True;
  CommBlock.CopyTo := False;
  CommBlock.Command := False;
  CommBlock.Msg := 'Login...';
  CommBlock.MsgDateTime := Now;
  CommBlock.ModuleID := '';
  CommBlock.BillNo := '';
  Try
    Client.WriteBuffer(CommBlock, SizeOf (CommBlock), true);
  Except
  end;
  //ReadMsg.Enabled := True;
end;

procedure TFmMsgClient.RzBitBtn3Click(Sender: TObject);
begin
  LblSrcInfo.Caption := '';
  mmoInfo.Clear;
  Close;
end;

procedure TFmMsgClient.ShowHistoryClick(Sender: TObject);
begin
  if not plHistMsg.Visible then
    ReadOldMsg;
  plHistMsg.Visible := not plHistMsg.Visible;
  if plHistMsg.Visible and (plHistMsg.Top>plViewMsg.Height) then
    plHistMsg.Top := plViewMsg.Height-1;
end;

procedure TFmMsgClient.BtnMsgSendClick(Sender: TObject);
begin
  plSendMsg.Visible := not plSendMsg.Visible;
  if plHistMsg.Visible and (plHistMsg.Top>plSendMsg.Height) then
    plHistMsg.Top := plViewMsg.Height-1;
end;

procedure TFmMsgClient.BtnNextMsgClick(Sender: TObject);
begin
  ReadTempMsg;
end;

procedure TFmMsgClient.BtnSendsClick(Sender: TObject);
begin
  if Trim(edMsg.Text)='' then
  begin
    edMsg.Clear;
    Exit;
  end;
  Send(CbxUsrList.Items[CbxUsrList.ItemIndex],edMsg.Text,False);
  edMsg.Clear;
  edMsg.SetFocus;
end;

procedure TFmMsgClient.ListHistoryClick(Sender: TObject);
begin
  if ListHisTory.Items.Count<1 then Exit;
  LblSrcInfo.Caption := ListHisTory.ItemFocused.Caption;
  MmoInfo.Clear;
  MmoInfo.Lines.Add(ListHisTory.ItemFocused.SubItems.Text);
  FindKeyDo(LblSrcInfo.Caption);
end;

procedure TFmMsgClient.ListHistoryKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=VK_DOWN) OR (KEY=VK_UP) THEN
  begin
    ListHistory.ItemFocused.Update;
    ListHistory.OnClick(Sender);
  end;
end;

procedure TFmMsgClient.BtnShowBillClick(Sender: TObject);
begin
  IFmMain.DoSome(OnceBlock.ModuleID, 'ViewBill',OnceBlock.BillNo);
end;

procedure TFmMsgClient.FindKeyDo(ItemKey: String);
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
begin
  AppPath := ExtractFilePath(Application.ExeName);
  if not DirectoryExists(AppPath+'NetMsg\') then
    MkDir(AppPath+'NetMsg\');
  AppName := AppPath+'NetMsg\'+Trim(LblAccount.Caption)+Trim(lblUser.Caption)+'.Dat';
  OldMsg := TiniFile.Create(AppName);
  OnceBlock.ModuleID := OldMsg.ReadString(LblSrcInfo.Caption,'ModuleID','');
  OnceBlock.BillNo := OldMsg.ReadString(LblSrcInfo.Caption,'BillNo','');
  OnceBlock.Command := StrToBool(OldMsg.ReadString(LblSrcInfo.Caption,'Command','0'));
  if OnceBlock.Command then
    BtnShowBill.Enabled := True
  else BtnShowBill.Enabled := False;
  OldMsg.Free;
end;

//每隔一段时间就向缓冲区发送一个消息
procedure TFmMsgClient.ReadMsgTimer(Sender: TObject);
var CommBlock :TCommBlock;
begin
  CheckNoReadMsg; //检查是否有消息
  CommBlock.AccountName := LblAccount.Caption;
  CommBlock.UserId := lblUser.Caption;
  commBlock.UserIP := ThisIP.LocalIP;
  CommBlock.DestId := lblUser.Caption;
  CommBlock.Online := True;
  CommBlock.CopyTo := False;
  CommBlock.Command := False;
  CommBlock.Msg := '_GetMsg$GetMsg_'; //如果没有消息，那么就向缓冲区写一个。这样做是防止读消息的线程死循环
  CommBlock.MsgDateTime := Now;
  CommBlock.ModuleID := '';
  CommBlock.BillNo := '';
  Try
    Client.WriteBuffer(CommBlock, SizeOf (CommBlock), true);
  Except
  end;
end;

procedure TFmMsgClient.edMsgKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=13)and(ssCtrl in Shift) then
    BtnSends.Click;
end;

procedure TFmMsgClient.FormActivate(Sender: TObject);
begin
  if Actived then Exit;
  plHistMsg.Visible := false;
  plSendMsg.Visible := false;
  Actived := true;
end;

procedure TFmMsgClient.OnMainFormReply(var Msg: TMessage);
begin
  with Msg do
    if msg=WM_ReplyChildForm then begin
      if LParam=1 then begin
        ReadTempMsg;
        Show;
      end;
    end;
end;

end.