tpwin.pas

Monitor.dfm Meter.dpr pasMain.pas

unit tpwin;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ComCtrls, Buttons, ToolWin, ExtCtrls;

type
  TFrmtpwin = class(TForm)
    OpenDialog1: TOpenDialog;
    TabControl1: TTabControl;
    TXTDB1: TEdit;
    CMDOPENDB1FILE: TButton;
    TXTDB2: TEdit;
    CMDOPENDB2FILE: TButton;
    TXTMID: TEdit;
    CMDOPENMIDFILE: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    CMBBAUD: TComboBox;
    CMBPORT: TComboBox;
    CMDQUIT: TButton;
    Label4: TLabel;
    Label5: TLabel;
    TXTMSG: TEdit;
    TXTONLINENO: TEdit;
    CMDOPENMSGFILE: TButton;
    CMDOPENONLINEFILE: TButton;
    Label6: TLabel;
    TXTNOFILE: TEdit;
    CMDOPENNOFILE: TButton;
    OPCOMMODE: TRadioGroup;
    OPCOMSTATUS: TRadioGroup;
    GroupBox1: TGroupBox;
    CMBSEND: TButton;
    CMBRECEIVE: TButton;
    CMBCHECK: TButton;
    CMBONLINENO: TButton;
    CMBREC_NO: TButton;
    CMBREGISTER: TButton;
    TXTMACNO: TEdit;
    procedure CMDQUITClick(Sender: TObject);
    procedure CMDOPENDB1FILEClick(Sender: TObject);
    procedure CMDOPENMIDFILEClick(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure CMDOPENMSGFILEClick(Sender: TObject);
    procedure CMDOPENONLINEFILEClick(Sender: TObject);
    procedure CMBSENDClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CMDOPENNOFILEClick(Sender: TObject);
    procedure CMBRECEIVEClick(Sender: TObject);
    procedure CMBBAUDChange(Sender: TObject);
    procedure CMBPORTChange(Sender: TObject);
    procedure OPCOMMODEClick(Sender: TObject);
    procedure OPCOMSTATUSClick(Sender: TObject);
    procedure CMBCHECKClick(Sender: TObject);
    procedure CMBONLINENOClick(Sender: TObject);
    procedure CMBREC_NOClick(Sender: TObject);
    procedure CMBREGISTERClick(Sender: TObject);
    procedure TXTMIDChange(Sender: TObject);
    procedure TXTDB1Change(Sender: TObject);
    procedure TXTDB2Change(Sender: TObject);
    procedure TXTMSGChange(Sender: TObject);
    procedure TXTONLINENOChange(Sender: TObject);
    procedure TXTNOFILEChange(Sender: TObject);
    procedure TXTMACNOChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frmtpwin: TFrmtpwin;
  nBaud, nCOM, nSingle, nEndOff, nMode, nResult:INTEGER;
  szMid, szDB1, szDB2, szMsg, szRDB1, szRDB2, szRMsg, szMacNo,
  szOnlineNo, szNoFile:string;
  szWorkPath, szInstallPath,szinitmid,szInitDb1,szInitDb2,szInitMsg,szInitBaud,
  szInitPort,szInitMach_id,szInitRdb1,szInitRdb2,szMess_Recv:pchar;

 implementation

uses pasMain;

FUNCTION  wSend(szLiba:string;szLibb:string;szMids:string;szMess:string;
szMac_no:string;single:integer;speed:integer;port:integer;endoff:integer;
Monitor:integer):integer;stdcall;external 'tpwin32.dll';

FUNCTION  wRegister(speed:integer;port: integer):integer;STDCALL;
EXTERNAL 'tpwin32.dll';
FUNCTION  wOnlineno(speed:integer;port:integer;filename:string;
monitor:integer):integer;STDCALL;EXTERNAL 'tpwin32.dll';
FUNCTION wSendp(szMid:string;szMsg:string;szMachNo:string;flag:integer;
speed:integer;port:integer;EndOff:integer;Monitor:integer):integer;STDCALL;
EXTERNAL 'tpwin32.dll';
FUNCTION wReceive(szDbf_A:string;szDbf_B:string;szMsg: string;szMachNo:string;
flag:integer;speed:integer;port:integer;EndOff:integer;Monitor:integer):integer;
STDCALL;EXTERNAL 'tpwin32.dll';
FUNCTION Rece_no(lpFilename:string;speed: integer;port: integer;
monitor:integer):integer;STDCALL;EXTERNAL'tpwin32.dll';
FUNCTION wCheck(szMid:string ;szMsg:string;szDbf_A: string ;szDbf_B: string ;
szMacNo: string ;Monitor: integer ):integer;STDCALL; EXTERNAL 'tpwin32.dll'
(*FUNCTION WritePrivateProfileString(
    lpszSection:STRING;// address of section name 
    lpszKey:STRING;	// address of key name 
    lpszString:STRING;	// address of string to add 
    lpszFile:STRING):BOOLEAN;STDCALL;EXTERNAL 'KERNEL32.DLL';*)
{$R *.DFM}

procedure TFrmtpwin.CMDQUITClick(Sender: TObject);
begin
        if frmmain.mscomm.portopen=false then frmmain.mscomm.portopen:=true;
        frmtpwin.close;
end;



procedure TFrmtpwin.CMDOPENDB1FILEClick(Sender: TObject);
begin
   opendialog1.Filter := 'dbf文件(*.DBF)|*.dbf';
   if opendialog1.execute then
      IF SENDER = CMDOPENDB1FILE THEN
         BEGIN
          TXTDB1.text:=opendialog1.FileName;
          SZDB1 := TXTDB1.TEXT;
         END
      ELSE
          BEGIN
           TXTDB2.TEXT:=opendialog1.FileName;
           SZDB2 := TXTDB2.TEXT;
          end;
END;

procedure TFrmtpwin.CMDOPENMIDFILEClick(Sender: TObject);
begin
 opendialog1.Filter := 'mid文件(*.MID)|*.mid';
   if opendialog1.execute then
     BEGIN
     TXTMID.text:=opendialog1.FileName;
     szmid :=TXTMID.TEXT;
     END;
end;

procedure TFrmtpwin.TabControl1Change(Sender: TObject);
begin
    IF TABCONTROL1.TABINDEX = 0 THEN
       BEGIN
              CMBSEND.Enabled := TRUE;
              CMBCHECK.Enabled := TRUE;
              CMBRECEIVE.ENABLED := FALSE;
              CMDOPENMIDFILE.ENABLED := TRUE;
              TXTMID.ENABLED := TRUE;
              TXTDB1.TEXT := szDB1;
              TXTDB2.TEXT := szDB2;
              TXTMSG.TEXT := szMSG;
       END
    ELSE
        BEGIN
              CMBSEND.Enabled := FALSE;
              CMBCHECK.Enabled := FALSE;
              CMBRECEIVE.ENABLED := TRUE;
              CMDOPENMIDFILE.ENABLED := FALSE;
              TXTMID.ENABLED := FALSE;
              TXTDB1.TEXT := szRDB1;
              TXTDB2.TEXT := szRDB2;
              TXTMSG.TEXT := szRMSG;
        END;
end;

procedure TFrmtpwin.CMDOPENMSGFILEClick(Sender: TObject);
begin
     opendialog1.Filter := 'MSG文件(*.MSG)|*.msg';
     if opendialog1.execute then
     BEGIN
     TXTMSG.text:=opendialog1.FileName;
     SZMSG := TXTMSG.TEXT;
     END;

end;

procedure TFrmtpwin.CMDOPENONLINEFILEClick(Sender: TObject);
begin
     opendialog1.Filter := 'DBF文件(*.DBF)|*.dbf';
     if opendialog1.execute then
     BEGIN
     TXTONLINENO.text:=opendialog1.FileName;
     SZONLINENO := TXTONLINENO.TEXT;
     END;

end;

procedure TFrmtpwin.CMBSENDClick(Sender: TObject);
var
   SZSTRING:STRING;
   nResult :integer;
begin
     if frmmain.mscomm.portopen=true then frmmain.mscomm.portopen:=false;
     if length(trim(szMid)) = 0 then
           MessageDlg('程序文件不存在.', mtInformation,[mbOk], 0)
     else
	 if length(trim(szDB1)) = 0 then
		nResult := wSendp(szMid, szMsg, szMacNo, nSingle, nBaud, nCOM, nEndOff, 1)
	else
		nResult := wSend(szDB1, szDB2, szMid, szMsg, szMacNo, nSingle, nBaud, nCOM, nEndOff, 1);
	if nResult <> 0 then
               BEGIN
                str(nResult,SZSTRING);
		MessageDlg('致命错误不能送文件.' + chr(13) + '错误号:'+SZSTRING, mtInformation,[mbok],0);
                END
	else
		MessageDlg('发送成功!',mtInformation,[mbok],0);
end;

procedure TFrmtpwin.FormCreate(Sender: TObject);
VAR
SZ:STRING;
begin
     
     getmem(szinstallPath,250);
     getmem(szworkpath,250);
     getmem(szInitbaud,250);
     getmem(szInitport,250);
     getmem(szInitmid,250);
     getmem(szInitDb1,250);
     getmem(szInitDb2,250);
     getmem(szInitmsg,250);
     getmem(szInitMach_id,250);
     getmem(szInitRdb1,250);
     getmem(szInitRdb2,250);
     getMem(szMess_Recv,250);

     GetPrivateProfileString('SETUP','InstallPath', '', szInstallPath, 256, 'TPWIN.INI');
     GetPrivateProfileString('SETUP','WorkPath','', szWorkPath, 256, 'TPWIN.INI');
     if szWorkPath = '' THEN
        szWorkPath := szInstallPath;
     getprivateprofilestring('setup','speed','38400',szInitBaud,256,'tpwin.ini');
     getprivateprofilestring('setup','port','com1',szInitPort,256,'tpwin.ini');
     //getprivateprofilestring('setup','DBF_SendA','',szInitDb1,256,'tpwin.ini');
     //getprivateprofilestring('setup','DBF_SendB','',szInitDb2,256,'tpwin.ini');
     //getprivateprofilestring('setup','Mid','',szInitMid,256,'tpwin.ini');
     getprivateprofilestring('setup','Mess_Send','',szInitMsg,256,'tpwin.ini');
     getprivateprofilestring('setup','Mach_id','',szInitMach_id,256,'tpwin.ini');
     //getprivateprofilestring('setup','DBF_RECVA','',szInitRdb1,256,'tpwin.ini');
     //getprivateprofilestring('setup','Dbf_RecvB','',szInitRdb2,256,'tpwin.ini');
     getprivateprofilestring('setup','Mess_Recv','',szMess_Recv,256,'tpwin.ini');
     txtOnlineno.text := szWorkPath + '\Onlineno.DBF';
     txtNoFile.text := szWorkPath + '\SERIES_N.DAT';
     opComMode.itemindex := 1;
     opComstatus.itemindex := 0;
     sz := szInitBaud;
     if sz = '38400' then
           begin
           cmbbaud.itemindex := 0;
           nbaud := 38400;
           end
     else
          if sz = '19200' then
           begin
           cmbbaud.itemindex := 1;
           nbaud := 19200;
           end
          else
           begin
           cmbbaud.itemindex := 2;
           nbaud := 9600;
           end;

     sz := szinitPort;
     if sz = '1' then
           begin
           cmbport.itemindex := 0;
           ncom := 1;