filetest.pas

GPRS/CDMA DTU数据中心源代码,基于DataCenterX控件开发.

unit filetest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SUIButton, ExtCtrls,ComCtrls;

type
  TfrmFileTest = class(TForm)
    btOpenFile: TsuiButton;
    btSendFile: TsuiButton;
    btStopSend: TsuiButton;
    edPackLen: TEdit;
    Label5: TLabel;
    edinteval: TEdit;
    Label4: TLabel;
    Memo2: TMemo;
    OpenDialog1: TOpenDialog;
    Timer2: TTimer;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    procedure btOpenFileClick(Sender: TObject);
    procedure btSendFileClick(Sender: TObject);
    procedure btStopSendClick(Sender: TObject);
    procedure edintevalKeyPress(Sender: TObject; var Key: Char);
    procedure edPackLenKeyPress(Sender: TObject; var Key: Char);
    procedure Timer2Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFileTest: TfrmFileTest;
  DataFileSend,DataFileRecv:file of Byte;
  Readlen,WriteLen:longint;
  rsize:longint;
  EEPROMVM:array[1..102500] of byte;
  SendInteval,PackLen:integer;
  FileSendDTU:string;

implementation

uses main;

{$R *.dfm}

procedure TfrmFileTest.btOpenFileClick(Sender: TObject);
begin
  opendialog1.FileName:='*.*';
  opendialog1.Title:='选择文件';
  if opendialog1.Execute=false  then exit;

  try
   AssignFile(DataFileSend,opendialog1.FileName);
   Reset(DataFileSend);
   rsize:=FileSize(DataFileSend);
   CloseFile(DataFileSend);

   AssignFile(DataFileSend,opendialog1.FileName);
   Reset(DataFileSend);


   btSendFile.Enabled:=true;
   btOpenFile.Enabled:=false;
  except
   showmessage('读取文件失败!');
   exit;
  end;
end;

procedure TfrmFileTest.btSendFileClick(Sender: TObject);
begin
  if  edpacklen.text='' then
  begin
    showmessage('请输入包长度');
    exit;
  end;
  if  edinteval.text='' then
  begin
    showmessage('请输入时间间隔');
    exit;
  end;

  if strtoint(edinteval.text)>100000 then
  begin
    showmessage('最大延时不能超过100000ms');
    exit;
  end;
  if strtoint(edpacklen.text)>100000 then
  begin
    showmessage('最大包长度不能超过100000字节');
    exit;
  end;

  SendInteval:=strtoint(edinteval.text);
  PackLen:=strtoint(edpacklen.text);

  Timer2.Interval:=SendInteval*1000;
  Timer2.Enabled:=true;

  edinteval.text:='';
  edpacklen.text:='';
  btStopSend.Enabled:=true;
  btsendfile.Enabled:=false;

end;

procedure TfrmFileTest.btStopSendClick(Sender: TObject);
begin
  Timer2.Enabled:=false;
  btOpenfile.Enabled:=true;
  btStopSend.Enabled:=false;
  closefile(datafileSend);
end;

procedure TfrmFileTest.edintevalKeyPress(Sender: TObject; var Key: Char);
begin
  if key=chr(8) then exit;
  if pos(key,'1234567890')=0 then key:=chr(0);
end;

procedure TfrmFileTest.edPackLenKeyPress(Sender: TObject; var Key: Char);
begin
  if key=chr(8) then exit;
  if pos(key,'1234567890')=0 then key:=chr(0);
end;

function sendstring(s1:string):integer;
var hexstr,s:string;
    i,j,k,ret:integer;
    dtuid:string;
    ws:widestring;
    p:pchar;
    listitem:tlistitem;
begin
         s:=s1;  dtuid:=filesenddtu;
         if frmmain.hex1.Checked then hexstr:=' {HEX:'+texttohexstr(s)+'}';
         if frmmain.ndatatip.Checked then   frmmain.memo1.lines.add(datetimetostr(now)+' 发送数据到'+ DTUID+' 数据内容:'+hexstr+s)
         else frmmain.memo1.lines.add(hexstr+s);
         frmfiletest.memo2.lines.add(s);

         setlength(ws,length(s));
         p:=@ws[1];
         for k:=1 to  length(s) do p[k-1]:=s[k];

         ret:=frmmain.datacenterx1.SendData(DTUID,ws,length(s));
         if ret=-1 then
         begin
             frmmain.memo1.lines.add('发送失败,'+DTUID+' TCP响应超时');
             exit;
         end;
         if ret=-2 then
         begin
             frmmain.memo1.lines.add('发送失败,'+DTUID+'不在线');
             exit;
         end;
         if ret=-3 then
         begin
             frmmain.memo1.lines.add('发送失败,'+DTUID+'不在DTU列表中');
             exit;
         end;

         for i:=0 to frmmain.ListView1.Items.Count-1 do
         begin
             listitem:=frmmain.ListView1.Items[i];
             if listitem.Caption=DTUID then
             begin
                 if listitem.SubItems[8]='' then listitem.SubItems[8]:='0';
                 if ret>=0 then listitem.SubItems[8]:=inttostr(strtoint(listitem.SubItems[8])+ret);
                 listitem.ImageIndex:=2;
                 break;
             end;
         end;
end;


procedure TfrmFileTest.Timer2Timer(Sender: TObject);
var s:string;
    i:integer;
begin
    timer2.Enabled:=false;
    BlockRead(DataFileSend,EEPROMVM,PackLen,Readlen);
    s:='';
    for i:=1 to readlen do
    begin
     s:=s+chr(EEPROMVM[i]);
    end;

    sendstring(s);
    timer2.Enabled:=true;

    if Readlen<PackLen then
    begin
       CloseFile(DataFileSend);
       Timer2.Enabled:=false;
       memo2.Lines.Add('文件发送完毕!');
       btStopSend.Enabled:=false;
       btOpenFile.Enabled:=true;
    end;
end;


procedure TfrmFileTest.FormShow(Sender: TObject);
begin
   caption:='文件收发 DTUID='+filesenddtu;
end;

procedure TfrmFileTest.CheckBox1Click(Sender: TObject);
var
  FileHandle : Integer;
begin
 if checkbox1.Checked then
 begin
  if edit1.text='' then
  begin
    showmessage('请指定文件名!');
    exit;
  end;
  FileHandle := FileCreate(edit1.text); 
  FileClose(FileHandle);

  try
   AssignFile(DataFileRecv,edit1.text);
   Reset(DataFileRecv);
  except
   showmessage('创建文件失败!');
  end;
 end
 else
 begin
   try
    closefile(datafilerecv);
   except
   end;
   edit1.text:='';
 end;
end;

end.