msgclient.pas

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

unit MsgClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, StrUtils,
  Dialogs,  RzEdit, RzLabel, ComCtrls, RzButton,IdTCPConnection, IdTCPClient,
  RzPanel,GlobalUnit, IniFiles, Menus, IdBaseComponent,IdComponent, IdIPWatch,
  Mask, ExtCtrls, StdCtrls, ImgList,iMainFrm,RzCmboBx, RzListVw;

const
  WM_OnChildFormAsk = WM_USER+901;
  WM_ReplyChildForm = WM_USER+902;

type
  TFmMsgClient = class(TForm)
    ThisIP: TIdIPWatch;
    Client: TIdTCPClient;
    plViewMsg: TRzPanel;
    RzLabel1: TRzLabel;
    FlatPanel1: TRzPanel;
    MmoInfo: TRichEdit;
    ShowHistory: TRzBitBtn;
    BtnMsgSend: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    ImageList1: TImageList;
    RzGroupBox1: TRzGroupBox;
    RzLabel5: TRzLabel;
    RzLabel6: TRzLabel;
    LblAccount: TRzLabel;
    lblUser: TRzLabel;
    lblSrcinfo: TRzLabel;
    BtnShowBill: TRzBitBtn;
    BtnNextMsg: TRzBitBtn;
    ReadMsg: TTimer;
    plHistMsg: TRzPanel;
    ListHistory: TRzListView;
    plSendMsg: TRzPanel;
    RzLabel2: TRzLabel;
    RzLabel4: TRzLabel;
    RzLabel3: TRzLabel;
    edMsg: TRzEdit;
    BtnSends: TRzBitBtn;
    CbxUsrList: TRzComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Send(DstId:String;Mesage:String;Command:Boolean);
    procedure RzBitBtn3Click(Sender: TObject);
    procedure ShowHistoryClick(Sender: TObject);
    procedure SaveOldMsg(Msg:TCommBlock);
    procedure ReadOldMsg;
    procedure SaveTempMsg(TempMsg:TCommBlock);
    procedure BtnNextMsgClick(Sender: TObject);
    procedure BtnSendsClick(Sender: TObject);
    procedure BtnMsgSendClick(Sender: TObject);
    procedure UserLogin;
    procedure ListHistoryClick(Sender: TObject);
    procedure ListHistoryKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnShowBillClick(Sender: TObject);
    procedure FindKeyDo(ItemKey:String);
    procedure ReadMsgTimer(Sender: TObject);
    procedure edMsgKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    TmpMsg:TStrings;
    OnceBlock:TCommBlock;
    Actived, Logined:Boolean;
    IFmMain :IMainForm;
    procedure Connection;
    procedure OnMainFormReply(var Msg: TMessage); message WM_ReplyChildForm;
  public
    { Public declarations }
    bUseServerMsg : Boolean;
  end;

  TClientHandleThread = class(TThread)
  private
    CB: TCommBlock;
    procedure HandleInput;
  protected
    procedure Execute; override;
  end;

Const
  ServerMsg= '消息处理服务器';

var
  FmMsgClient: TFmMsgClient;
  MsgServerIP: String;
  ClientHandleThread: TClientHandleThread;
  LoginOut :Boolean=False;

Procedure ShowMsg;
procedure SendMsg(DstId:String;Msg:String;Command:Boolean=False);
Procedure SendBillTo(DestId:String;Msg:String;ModuleId:String;BillNo:String;Command:Boolean);
procedure LogInMsg(LoginName, AccountName, sSvrIP:String);
procedure LogOutMsg;
Function CheckNoReadMsg:Integer;
Procedure ReadTempMsg;

implementation

{$R *.dfm}

Procedure SendBillTo(DestId:String;Msg:String;ModuleId:String;BillNo:String;Command:Boolean);
var  CommBlock :TCommBlock;
begin
  CommBlock.AccountName := fmMsgClient.LblAccount.Caption;
  CommBlock.UserId := fmMsgClient.lblUser.Caption;
  commBlock.UserIP := fmMsgClient.ThisIP.LocalIP;
  CommBlock.DestId := DestId;
  CommBlock.Online := True;
  CommBlock.CopyTo := False;
  CommBlock.Command := Command;
  CommBlock.Msg := Msg;
  CommBlock.MsgDateTime := Now;
  CommBlock.ModuleID := ModuleId;
  CommBlock.BillNo := BillNo;
  Try
    FmMsgClient.Client.WriteBuffer(CommBlock, SizeOf (CommBlock), true);
  Except
  end;
end;

Function CheckNoReadMsg:Integer;
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
begin
  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(FmMsgClient.TmpMsg);
  OldMsg.Free;
  if FmMsgClient.TmpMsg.Count>1 then
  begin
    FmMsgClient.BtnNextMsg.Visible := True;
    FmMsgClient.BtnNextMsg.Enabled := True;
  end else begin
    FmMsgClient.BtnNextMsg.Enabled := False;
    Result := FmMsgClient.TmpMsg.Count;
  end;
end;

Procedure ShowMsg;
begin
  if not Assigned(FmMsgClient) then begin
    Exit;
  end;
  FmMsgClient.Height := 180;
  FmMsgClient.Show;
end;

procedure LoginMsg(LoginName, AccountName, sSvrIP: String);
begin
  MsgServerIP := sSvrIP;
  if not Assigned(FmMsgClient) then begin
    FmMsgClient := TFmMsgClient.Create(Application);
  end;
  FmMsgClient.LblAccount.Caption := AccountName;
  FmMsgClient.lblUser.Caption := LoginName;
  FmMsgClient.Update;
  FmMsgClient.UserLogin;
end;

procedure LogOutMsg;
begin
  if Not Assigned(FmMsgClient) then begin
    Exit;
  end;
  try
    ClientHandleThread.Terminate;
    FmMsgClient.Client.Disconnect;
  except
  end;
  LoginOut := True;
  FmMsgClient.Close;
  FreeAndNil(FmMsgClient);
end;

procedure SendMsg(DstId:String;Msg:String;Command:Boolean=False);
begin
  if not Assigned(FmMsgClient) then begin
    Exit;
  end;
  FmMsgClient.Send(DstId,Msg,Command);
end;

Procedure TFmMsgClient.Send(DstId:String;Mesage:String;Command:Boolean);
var  CommBlock :TCommBlock;
begin
  CommBlock.AccountName := LblAccount.Caption;
  CommBlock.UserId := lblUser.Caption;
  commBlock.UserIP := ThisIP.LocalIP;
  CommBlock.DestId := DstId;
  CommBlock.Online := True;
  CommBlock.CopyTo := False;
  CommBlock.Command := False;
  CommBlock.Msg := Mesage;
  CommBlock.MsgDateTime := Now;
  CommBlock.ModuleID := '';
  CommBlock.BillNo := '';
  Try
    Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
  Except
  end;
end;

procedure TFmMsgClient.SaveOldMsg(Msg:TCommBlock);
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
    msgSection: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';
  If Trim(Msg.DestId) = ServerMsg Then Begin
    AppName := AppPath+'NetMsg\'+Trim(LblAccount.Caption)+Trim(lblUser.Caption)+'.Dat';
  End Else
    AppName := AppPath+'NetMsg\'+Trim(LblAccount.Caption)+Trim(Msg.DestId)+'.Dat'; {renshi 20030318}
  OldMsg := TiniFile.Create(AppName);
  msgSection:=Trim(DateTimeToStr(Msg.MsgDateTime))+'::'+Trim(Msg.DestId);
  OldMsg.WriteString(msgSection,'Msg',Msg.Msg);
  OldMsg.WriteString(msgSection,'ModuleID',Msg.ModuleID);
  OldMsg.WriteString(msgSection,'BillNo',Msg.BillNo);
  OldMsg.WriteString(msgSection,'Command',BoolToStr(Msg.Command));
  OldMsg.Free;
end;

procedure TFmMsgClient.ReadOldMsg;
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
    Row :integer;
    List :TListItem;
    SubMsg :String;
    ListTitle :TStrings;
    MaxRow:Integer;
begin
  ListTitle := TStringList.Create;
  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);
  OldMsg.ReadSections(ListTitle);
  ListHistory.Clear;
  MaxRow:=ListTitle.Count-1-100;
  if Maxrow<0 then
    Maxrow := 0
  else
    MaxRow := ListTitle.Count-1-100;
  For Row:=ListTitle.Count-1 Downto MaxRow do
  begin
    SubMsg:=OldMsg.ReadString(ListTitle[Row],'Msg','');
    List := ListHistory.Items.Add;
    List.Caption := ListTitle[Row];
    List.SubItems.Add(Trim(SubMsg));
  end;
  OldMsg.Free;
  ListTitle.Free;
end;

procedure TFmMsgClient.SaveTempMsg(TempMsg:TCommBlock);
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
    msgSection:String;
begin
  AppPath := ExtractFilePath(Application.ExeName);
  if not DirectoryExists(AppPath+'Temp\') then
    MkDir(AppPath+'Temp\');
  AppName := AppPath+'Temp\~'+DateToStr(Now)+'.Tmp';
  OldMsg := TiniFile.Create(AppName);
  msgSection:=Trim(DateTimeToStr(TempMsg.MsgDateTime))+'::'+Trim(TempMsg.DestId);
  OldMsg.WriteString(msgSection,'Msg',TempMsg.Msg);
  OldMsg.WriteString(msgSection,'ModuleID',TempMsg.ModuleID);
  OldMsg.WriteString(msgSection,'BillNo',TempMsg.BillNo);
  OldMsg.WriteString(msgSection,'Command',BoolToStr(TempMsg.Command));
  OldMsg.Free;
end;

Procedure ReadTempMsg;
var OldMsg:TiniFile;
    AppName:String;
    AppPath:String;
     Row :Integer;