📄 tp800_delphi.pas
字号:
unit TP800_Delphi;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Button1: TButton;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
OpenDialog1: TOpenDialog;
Label5: TLabel;
Edit3: TEdit;
Button6: TButton;
Button7: TButton;
TabSheet3: TTabSheet;
Button8: TButton;
Edit4: TEdit;
Label6: TLabel;
Label7: TLabel;
Edit5: TEdit;
Button9: TButton;
TabSheet4: TTabSheet;
Button11: TButton;
Edit6: TEdit;
Edit7: TEdit;
Label8: TLabel;
Label9: TLabel;
Button12: TButton;
ProgressBar1: TProgressBar;
Button10: TButton;
Button14: TButton;
Edit8: TEdit;
Label1: TLabel;
ComboBox1: TComboBox;
Label2: TLabel;
ComboBox2: TComboBox;
RadioGroup1: TRadioGroup;
Label10: TLabel;
Label11: TLabel;
Edit9: TEdit;
Button13: TButton;
Edit10: TEdit;
Label12: TLabel;
ProgressBar2: TProgressBar;
Button15: TButton;
Button16: TButton;
Button17: TButton;
Button18: TButton;
Edit11: TEdit;
Button19: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure Button15Click(Sender: TObject);
procedure Button16Click(Sender: TObject);
procedure Button17Click(Sender: TObject);
procedure Button18Click(Sender: TObject);
procedure Button19Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
nresult: integer;
nresult1: integer;
nresult2: integer;
nresult3:integer;
ndir:integer;
nport: integer;
nbaud: integer;
ncover: integer;
pcfile: boolean;
lpszerrormsg:array[0..39] of char;
errorcode:integer;
nstop:integer;
s:integer;
i:integer;
n:integer;
percent:integer;
c:char;
verdll:integer;
dllver:integer;
hcnum:string;
num:integer;
implementation
FUNCTION SendFileToHc(nport:integer;nbaudrate:integer;lpszHcFilename:string;
lpszOpenFileName:string;nattrib:integer;fprompt:integer) : integer;
stdcall;external 'comdll.dll';
FUNCTION thrdSendFileToHc(nport:integer;nbaudrate:integer;lpszHcFilename:string;
lpszOpenFileName:string;nattrib:integer;fprompt:integer) : integer;
stdcall;external 'comdll.dll';
//function GetErrorMsg(nErrorCode:string;lpszErrorMsg:string):void;stdcall;external 'comdll.dll';
FUNCTION GetErrorMsg(nerrorcode:integer;lpszerrormsg: array of char):integer;stdcall;external 'comdll.dll';
function thrdStop(fStopMode:integer):integer;stdcall;external 'comdll.dll';
FUNCTION thrdSendMifToHc(nport:integer;nbaudrate:integer;lpszOpenFileName:string;
nattrib:integer;fprompt:integer) : integer;stdcall;external 'comdll.dll';
FUNCTION DelHcFile(nPort:integer;nBaudrate:integer;lpszHcFileName:string;fPrompt:integer):integer;
stdcall;external 'comdll.dll';
FUNCTION DelHcMif(nPort:integer;nBaudrate:integer;lpszHcFileName:string;fPrompt:integer):integer;
stdcall;external 'comdll.dll';
FUNCTION GetHcFile(nPort:integer; nBaudrate:integer; lpszHcFileName:string;lpszSaveAs:string; fPrompt:integer):integer;
stdcall;external 'comdll.dll';
FUNCTION thrdGetHcFile(nPort:integer; nBaudrate:integer; lpszHcFileName:string; lpszSaveAs:string; fPrompt:integer):integer;
stdcall;external 'comdll.dll';
function thrdQueryStatus():integer;stdcall;external 'comdll.dll';
function thrdQueryPercent():integer;stdcall;external 'comdll.dll';
function GetHcDirInfo(nPort:integer; nBaudrate:integer; lpszHcFileName:string;
lpszDirInfoFile:string;lpnFiles:pinteger;lpnSize:pinteger;fPrompt:integer):integer; stdcall;external 'comdll.dll';
function GetHcFileInfo(nPort:integer; nBaudrate:integer; lpszHcFileName:string; lpFileInfoBuffer:pstring):integer; stdcall;external 'comdll.dll';
function GetHcSysInfo(nPort:integer; nBaudrate:integer; lpszSysInfoFile:string; lpBuffer:pstring):integer;stdcall;external 'comdll.dll';
function HcMakeDir(nPort:integer; nBaudrate:integer; name:string):integer;stdcall;external 'comdll.dll';
function thrdGetHcMif(nPort:integer; nBaudrate:integer; lpszHcFileName:string; fPrompt:integer):integer;stdcall;external 'comdll.dll';
function HcDelDir(nPort:integer; nBaudrate:integer; name:string):integer;stdcall;external 'comdll.dll';
function thrdGetHcNum(nPort:integer; nBaudrate:integer; lpszHcNum:string):integer;stdcall;external 'comdll.dll';
function GetDllVer():integer;stdcall;external 'comdll.dll';
function HcRescue(nPort:integer; nBaudrate:integer; filename:string):integer;stdcall;external 'comdll.dll';
function HcGetCurDir(nPort:integer; nBaudrate:integer; dir:string):integer;stdcall;external 'comdll.dll';
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Close
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (edit1.Text='') then
begin
messagedlg('无可用文件！！！',mtInformation,[mbok],0);
exit;
end;
if (edit2.text='') then
begin
s:=length(edit1.text);
//messagedlg(inttostr(s),mtInformation,[mbok],0);
repeat
c:=edit1.text[s];
s:=s-1;
until c='\';
s:=s+2;
i:=s;
s:=length(edit1.text);
edit2.text:=copy(edit1.text,i,(s-i+1));
end;
nresult:= SendFileToHc(nport,nbaud,edit2.Text,edit1.Text,1,ncover);
//messagedlg(inttostr(nresult),mtInformation,[mbok],0);
if (nresult=0) then
begin
messagedlg('恭喜您！文件发送成功！',mtinformation,[mbok],0);
end;
if (nresult<>0) then
begin
GetErrorMsg(errorcode,lpszerrormsg);
messagedlg(trim(lpszerrormsg),mtInformation,[mbok],0);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
progressbar1.Position:=0;
if (edit1.Text='') then
begin
messagedlg('无可用文件！！！',mtInformation,[mbok],0);
exit;
end;
if (edit2.text='') then
begin
s:=length(edit1.text);
repeat
c:=edit1.text[s];
s:=s-1;
until c='\';
s:=s+2;
i:=s;
s:=length(edit1.text);
edit2.text:=copy(edit1.text,i,(s-i+1));
end;
nresult:= thrdSendFileToHc(nport,nbaud,edit2.Text,edit1.Text,1,ncover);
//messagedlg(inttostr(nresult),mtInformation,[mbok],0);
// repeat
// progressbar1.Position:=thrdQueryPercent();
// until thrdquerypercent()=100;
// progressbar1.Position:=100;
//if (nresult=0) then
repeat
progressbar1.Position:=thrdQueryPercent();
//percent:=progressbar1.Position;
n:=thrdQueryStatus();
until (n=0) or (n=32768) ;
// messagedlg('恭喜您！文件发送成功！',mtinformation,[mbok],0);
if (n=0) then
begin
messagedlg('恭喜您！文件发送成功！',mtinformation,[mbok],0);
end;
if (n=32768) then
begin
messagedlg('很遗憾，发送失败！！！',mtinformation,[mbok],0);
end;
if (nresult<>0) then
begin
GetErrorMsg(errorcode,lpszerrormsg);
messagedlg(trim(lpszerrormsg),mtInformation,[mbok],0);
end;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
case ComboBox1.itemindex of
0:nport := 0;
1:nport := 1;
2:nport := 2;
3:nport := 3;
4:nport := 4;
end;
//messagedlg(inttostr(nport),mtinformation,[mbok],0);
//messagedlg(inttostr(nbaud),mtinformation,[mbok],0);
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
case ComboBox2.itemindex of
//0:nbaud := 999999;
0:nbaud := 115200;
1:nbaud := 57600;
2:nbaud := 38400;
3:nbaud := 9600;
end;
if nport=0 then
begin
combobox2.Visible:=false
end
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
opendialog1.Filter := '文件(*.*)|*.*';
pcfile:=opendialog1.Execute;
if pcfile then
begin
edit1.Text:=opendialog1.FileName;
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
ncover := radiogroup1.itemindex;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
nstop:=thrdStop(2);
// GetErrorMsg(errorcode,lpszerrormsg);
// messagedlg(trim(lpszerrormsg),mtInformation,[mbok],0);
//messagedlg(inttostr(nstop),mtInformation,[mbok],0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
lpszerrormsg:='';
nresult:=99;
nresult1:=99;
nresult2:=99;
nresult3:=99;
n:=99;
nport:=0;
nbaud:=115200;
edit1.Text:='';
//edit2.Text:='';
edit2.text:='';
edit3.Text:='';
ncover:=2;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
//opendialog1.Filter := 'MIF文件(*.MIF)|*.mif';
opendialog1.Filter := 'MIF文件(*.MIF)|*.*';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -