串口传文件delphi.txt

串口传文件DELPHI的主要PAS文件 是发送端的

unit SendFile;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, SendThread, ImgList, FileCtrl, QDialogs;

type
  TForm1 = class(TForm)
    lblFileName: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Panel1: TPanel;
    Label4: TLabel;
    Label6: TLabel;
    Image1: TImage;
    edFileName: TEdit;
    mmInfo: TMemo;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    Timer2: TTimer;
    TreeView: TTreeView;
    Label1: TLabel;
    Button3: TButton;
    Button4: TButton;
    Button2: TButton;
    DriveComboBox: TDriveComboBox;
    FileListBox: TFileListBox;
    ImageList1: TImageList;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TreeViewExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeViewCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
  private
    { Private declarations }
    procedure ReadPort; //读串口函数
    procedure WritePort(s: String); //写串口函数
    function  OpenCom: Boolean;  //打开串口过程
    function  DiskInDrive(const Drive: String): Boolean; //检查驱动器中是否有磁盘
    procedure InitDirve; //初始化主盘符过程
  public
    { Public declarations }
  end;

const
    datasize=1024; //数据块大小
    INPUTBUFFSIZE=4096; //缓冲区大小

var
  Form1: TForm1;
  hComm: THandle;
  FileStream: TFileStream; //发送文件流变量
  szInputBuffer: array[0..INPUTBUFFSIZE-1] of Char;
  FInputData: String;
  ReadLength: Integer;
  
implementation

{$R *.dfm}

function  TForm1.OpenCom: Boolean;
var
    dcb: Tdcb;
    temp: String;
begin
    temp:='COM1'; //选择要打开的通信端口
    hComm:=CreateFile(PChar(temp),GENERIC_READ or GENERIC_WRITE,0,
                      nil,OPEN_EXISTING,0,0);
    if (hComm=INVALID_HANDLE_VALUE) then //如果通信端口没有打开
    begin
        MessageBox(0,'打开通信端口错误！','Error',MB_OK);
        Result:=false;
        exit;
    end;

    GetCommState(hComm,dcb); //取得目前通信端口状态
    dcb.BaudRate:=CBR_9600; //波特率
    dcb.ByteSize:=8;  //数据位
    dcb.StopBits:=ONESTOPBIT; //1位停止位
    dcb.Parity:=NOPARITY; //Parity 为 None

    if not SetCommState(hComm,dcb) then //设置通信端口的状态
    begin
        MessageBox(0,'设置通信端口错误！','Error',MB_OK);
        CloseHandle(hComm);
        Result:=false;
        exit;
    end;

    Result:=true;  //正常，返回TRUE
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
    StatusBar1.Panels[1].Text:=FormatDateTime('hh:mm:ss',Now);
    //Application.ProcessMessages;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
    StatusBar1.Panels[0].Text:=FormatDateTime('yyyy-mm-dd',Now);
    if OpenCom then
       StatusBar1.Panels[2].Text:=' 已经和COM1端口连接！'
    else
       StatusBar1.Panels[2].Text:=' 打开COM1端口错误！';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
    CloseHandle(hComm);
    Close;
end;


//传送功能
procedure TForm1.Button2Click(Sender: TObject);
var
    lrc: LongWord;
    str: String;
begin
    //判断要发送的文件是否合法
    if (not FileExists(edFileName.Text)) then
    begin
        ShowMessage('选择要发送的文件名不合法!');
        exit;
    end;
    //发送文件基本信息
    FileStream:=TFileStream.Create(edFileName.Text,fmOpenRead);
    str:='%HEAD%'+ExtractFilename(edFileName.Text)+'%'+ InttoStr(FileStream.Size) +'%';
    if hComm=0 then exit;  //若尚未打开通信端口，则退出
    //执行送出的函数
    WriteFile(hComm,Pointer(str)^,Length(str),lrc,nil);

    StatusBar1.Panels[2].Text:=' 正在传送文件'+ edFileName.Text + '...';
    mmInfo.Lines.Add('正在传送文件'+edFileName.Text+'，大小为：'+InttoStr(FileStream.Size));
end;

procedure TForm1.ReadPort;
var
    temp: String;
    //inbuff: array[0..INPUTBUFFSIZE-1] of char;
    nBytesRead,dwError: LongWord;
    cs: TCOMSTAT;
    //ReadLen: DWORD;
begin
    //初始化
    //FillChar(inbuff,SizeOf(inbuff),0);
    if (hComm=0) then exit;  //先判断是否已打开通信端口
    ClearCommError(hComm,dwError,@cs); //取得状态
    ReadFile(hComm,szInputBuffer,cs.cbInQue,nBytesRead,nil); //读取端口数据

    //串口在读取数据后，会自动将缓冲区中已被读取的数据清除掉
    if (cs.cbInQue=0) then exit;

    //ReadLen:=cs.cbInQue;
    //数据是否大于所准备的Buffer
    if cs.cbInQue > SizeOf(szInputBuffer) then
    begin
        PurgeComm(hComm,PURGE_RXCLEAR); //清除通信端口数据
        exit;
    end;

    //取出数据
    temp:=Copy(szInputBuffer,1,cs.cbInQue);
    WritePort(temp);
    //PurgeComm(hComm,PURGE_RXCLEAR); //清除通信端口数据
end;

//写串口数据过程
{-----------------接收端返回值有三种状态
                  　　OK--正常
                  　　ERROR--错误
                  　　END--结束
----------------------------------------}
procedure TForm1.WritePort(s: String);
var
    x: Integer;
    //bianliang1: array[0..89] of Char;
    buff: Pointer;
    lrc: LongWord;
begin
    if s='OK' then
    begin
        GetMem(buff,datasize);
        x:=FileStream.Read(buff^,datasize);
         //往串口写入数据
        WriteFile(hComm,buff^,x,lrc,nil);
        FreeMem(buff,datasize);
        //显示文件发送进度
        ReadLength:=x+ReadLength;
        ProgressBar1.Position:=Round((ReadLength / FileStream.Size)*100);
        mmInfo.Lines.Add('ok');
        PurgeComm(hComm,PURGE_RXCLEAR and PURGE_TXCLEAR); //清空缓冲区
        exit;
    end;

    if s='ERROR' then
    begin
        { Place code here } //调试阶段，暂不考虑
        exit;
    end;

    if s='END' then
    begin
        FileStream.Free;
        mmInfo.Lines.Add('文件已发送完毕！');
        StatusBar1.Panels[2].Text:=' 文件已成功接收！';
        ReadLength:=0;
        PurgeComm(hComm,PURGE_RXCLEAR and PURGE_TXCLEAR); //清空缓冲区
        exit;
    end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
    ReadPort;  //读取串口函数
end;

//初始化主盘符过程
procedure TForm1.InitDirve;
var
    firstnode,dirnode: TTreeNode;
    itemcount,index: Integer;
    itemstr: String;
begin
    firstnode:=TreeView.Items.GetFirstNode;
    itemcount:=DriveComboBox.Items.Count;
    for index:=0 to itemcount-1 do
    begin
        itemstr:=DriveComboBox.Items[index];
        itemstr:=Copy(itemstr,1,Pos(':',itemstr));
        dirnode:=TreeView.Items.AddChild(firstnode,itemstr);
        dirnode.HasChildren:=true;
        dirnode.ImageIndex:=1;
        dirnode.SelectedIndex:=1;
    end;
end;

//检查驱动器中是否有磁盘
function TForm1.DiskInDrive(const Drive: String): Boolean;
var
   DrvNum: byte;
   EMode: Word;
   s: String; //临时变量
begin
   s:='请将磁盘插入驱动器'+UpperCase(Drive)[1];
   result := false;
   DrvNum := ord(Drive[1]);
   if DrvNum >= ord('a') then dec(DrvNum,$20);
   EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
   try
      if DiskSize(DrvNum-$40) <> -1 then
         result := true
      else
         MessageDlg('插入磁盘',s,mtInformation,[mbOK],0,mbOK,nil);
   finally
      SetErrorMode(EMode);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     //初始化过程
     InitDirve;
end;

procedure TForm1.TreeViewExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
   dirnode:TTreeNode;
   itemcount,index,level:integer;
   itemstr,strpath,filename:string;
   fileflag:integer;
begin
  if node.level<>0 then
    begin
      node.ImageIndex:=3;
      node.SelectedIndex:=3;
    end;
  if node.Count=0 then
    begin
        strpath:=node.Text+'\';
        dirnode:=node;
        level:=node.Level;

        while level<>0 do
        begin
           strpath:=dirnode.Parent.Text+'\'+strpath;
           dirnode:=dirnode.Parent;
           level:=level-1;
        end;
        filelistbox.Items.Clear;
        //icount:=0;
        if not DiskInDrive(strpath) then exit;
        filelistbox.Directory:=strpath;
        itemcount:=filelistbox.Items.Count;
        for index:=0 to itemcount-1 do
        begin
           itemstr:=filelistbox.Items[index];
           filename:=itemstr;
           fileflag:=pos(']',itemstr);
           itemstr:=copy(itemstr,2,pos(']',itemstr)-2);

           if (fileflag<>0) and (itemstr<>'.') and (itemstr<>'..') then
             begin
                dirnode:=treeview.Items.AddChild(node,itemstr);
                dirnode.HasChildren:=true;
                dirnode.ImageIndex:=2;
                dirnode.SelectedIndex:=2;
                //icount:=icount+1;
             end;
           if (fileflag=0) and (itemstr<>'.') and (itemstr<>'..') then
             begin
                dirnode:=treeview.Items.AddChild(node,filename);
                dirnode.HasChildren:=false;
                dirnode.ImageIndex:=4;
                dirnode.SelectedIndex:=4;
             end;
         end;
     end;
end;

procedure TForm1.TreeViewCollapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
begin
   if node.Level<>0 then
   begin
      node.ImageIndex:=2;
      node.SelectedIndex:=2;
   end;
end;

procedure TForm1.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
    filepath: String;
    level: Integer;
    dirnode: TTreeNode;
begin
    dirnode:=Node;
    level:=dirnode.Level;
    filepath:=dirnode.Text;
    while level<>0 do
    begin
        filepath:=dirnode.Parent.Text+'\'+filepath;
        dirnode:=dirnode.Parent;
        level:=level-1;
    end;
    edFileName.Text:=filepath;
end;

end.