port.pas

delphi和SQL的结合

unit port;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB, SPComm;//SPComm

type
  Tserialport = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Button3: TButton;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox5: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ComboBox4: TComboBox;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Comm1: TComm;
    edPath: TEdit;
    cbRecHex: TCheckBox;
    btnSwitch: TButton;
    Memo1: TMemo;
    Button4: TButton;
    procedure ComboBox1Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure btnSwitchClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
     FShowText:Boolean;
  public
    { Public declarations }
  end;

var
  serialport: Tserialport;

implementation

uses realtime;

{$R *.dfm}
procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit; //raise EComPort.Create(CError_RegError, ErrCode);

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;

end;



procedure Tserialport.ComboBox1Change(Sender: TObject);
begin
Comm1.CommName:=ComboBox1.text
//self.ComboBox1.Items.Add('1');
//self.ComboBox1.Items.Add('2');
//self.ComboBox1.ItemIndex:=0;
end;
procedure Tserialport.Button3Click(Sender: TObject);
begin
close;
end;

procedure Tserialport.Button1Click(Sender: TObject);

var
  S:string;
begin
S :=edPath.Text;
  if not DirectoryExists(S) then
    CreateDir(S);
  S:=S+'Rec'+formatdatetime('yymmddhhnnss',now)+'.txt';
  Memo1.Lines.SaveToFile(S);
  Application.MessageBox(pchar(s+#13#13#9+'已保存'),'信息',MB_ICONWARNING or MB_OK);
   //if   SaveDialog1.execute   then
      //begin
          //AssignFile(F,   SaveDialog1.FileName);
          //Rewrite(F);
          //Write(F,   '.txt');
          //CloseFile(F);
          end;

procedure Tserialport.ComboBox2Change(Sender: TObject);
 var  BaudRate : Integer;
begin
 if ComboBox2.Text = 'Custom' then
    begin
      ComboBox2.Style := csDropDown;
      ComboBox2.SetFocus;
    end
  else begin
    if  ComboBox2.ItemIndex >0 then
      ComboBox2.Style := csDropDownList;
    if TryStrToInt(ComboBox2.Text,BaudRate) then
           Comm1.BaudRate := BaudRate;
end;
end;
procedure Tserialport.ComboBox2KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9',#8]) then Key := #0;
end;
function StrToHexStr(const S:string):string;
//字符串转换成16进制字符串
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;

procedure Tserialport.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var str :string;
begin
SetLength(Str,BufferLength);
  move(buffer^,pchar(@Str[1])^,bufferlength);
  if FShowText then
  begin
    if cbRecHex.Checked then
    Memo1.Text:=Memo1.Text+FormatDatetime('YYYYMMDDHHmmSS',Now)+StrToHexStr(Str)+' '
    else
      Memo1.Text := Memo1.Text + Str;
  Memo1.SelStart := Length(Memo1.Text);
  Memo1.SelLength:= 0;
  Memo1.Perform(EM_SCROLLCARET,0,0);
  end;
end;

procedure Tserialport.ComboBox3Change(Sender: TObject);
begin
Comm1.Parity := TParity(ComboBox3.ItemIndex);
end;

procedure Tserialport.ComboBox4Change(Sender: TObject);
begin
Comm1.ByteSize :=  TByteSize(ComboBox4.ItemIndex);
end;

procedure Tserialport.ComboBox5Change(Sender: TObject);
begin
  Comm1.StopBits := TStopBits(ComboBox5.ItemIndex);
end;

procedure Tserialport.btnSwitchClick(Sender: TObject);
var BaudRate :integer;
begin
if btnSwitch.Caption = '打开串口' then
  begin
  if not TryStrToInt(ComboBox2.Text,BaudRate) then
     begin
     Application.MessageBox('波特率设定有误'+#13+
                             ' 请重新输入','警告',MB_ICONWARNING or MB_OK);
     ComboBox2.SetFocus;
     exit;
     end;

  Comm1.StartComm;
  btnSwitch.Caption := '关闭串口';
  ComboBox1.Enabled := false;
  ComboBox2.Enabled := false;
  ComboBox3.Enabled := false;
  ComboBox4.Enabled := false;
  ComboBox5.Enabled := false;
  //btnSend.Enabled   := true;
  //ImageOff.Visible  := false;
  //ImageOn.Visible   :=true;
  end
else //if Button1.Caption = '关闭串口' then
  begin
  Comm1.StopComm;
  btnSwitch.Caption := '打开串口';
  ComboBox1.Enabled := true;
  ComboBox2.Enabled := true;
  ComboBox3.Enabled := true;
  ComboBox4.Enabled := true;
  ComboBox5.Enabled := true;
  //btnSend.Enabled   := false;
  //ImageOn.Visible   := false;
  //ImageOff.Visible  :=true;
  end;
//Timer1.Enabled := cbAutoSend.Checked;
//ShowStatus;
end;

procedure Tserialport.FormCreate(Sender: TObject);
//var myMenu : HMENU;
begin
  //FrmMain.Constraints.MinHeight := minHeight;
  //FrmMain.Constraints.MinWidth  := minWidth;

  FShowText:=True;
  //FRXNum:=0;
  //FTXNum:=0;
  //EnumComPorts(ComboBox1.Items);    //得到串口列表
  ComboBox1.ItemIndex := 0;
  Comm1.CommName := ComboBox1.Text;
  ComboBox2.ItemIndex := 6;
  Comm1.BaudRate := StrToInt(ComboBox2.Text);
  ComboBox3.ItemIndex := 0;
  Comm1.Parity := None;
  ComboBox4.ItemIndex := 3;
  Comm1.ByteSize := _8;
  ComboBox5.ItemIndex := 0;
  Comm1.StopBits := _1;

  //myMenu :=  GetSystemMenu(Handle, False);
  //AppendMenu(myMenu, MF_SEPARATOR, 0, '');
  //AppendMenu(myMenu, MF_STRING, idAbout, '关于');

end;


procedure Tserialport.Button4Click(Sender: TObject);
begin
Memo1.Clear;
end;

procedure Tserialport.Button2Click(Sender: TObject);
begin
Real_time.show;
end;

end.