ARM-PowerPC-ColdFire-MIPS

Development Platform:
MultiPlatform

EEPROM_form.pas：Code Content
							{-----------------------------------------------------------------------------
 Unit Name:  Unit1
 Author :    A1.Aleyn.wu
 E-mail :    Aleyn@e-midas.cn
 QQ/Group:   2282902/7617215
 Purpose:
 History:    v1.0
-----------------------------------------------------------------------------}
unit EEPROM_form;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DB, DBGrids, StdCtrls, DBClient, ExtCtrls, ToolWin,
  ComCtrls, CPort, ActnList, CPortCtl, HMRegistry;
type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    cdsAVR: TClientDataSet;
    cdsAVRF1: TStringField;
    cdsAVRF2: TStringField;
    cdsAVRF3: TStringField;
    cdsAVRF4: TStringField;
    cdsAVRF5: TStringField;
    cdsAVRF6: TStringField;
    cdsAVRF7: TStringField;
    cdsAVRF8: TStringField;
    cdsAVRF9: TStringField;
    cdsAVRFA: TStringField;
    cdsAVRFB: TStringField;
    cdsAVRFC: TStringField;
    cdsAVRFD: TStringField;
    cdsAVRFE: TStringField;
    cdsAVRFF: TStringField;
    cdsAVRFS: TStringField;
    ToolBar1: TToolBar;
    ActionList1: TActionList;
    actHelp: TAction;
    actRead: TAction;
    actWrite: TAction;
    actExit: TAction;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    actStart: TAction;
    actStop: TAction;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    cdsAVRF0: TStringField;
    cdsAVRFI: TStringField;
    prs: TProgressBar;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    actOpen: TAction;
    actSave: TAction;
    ToolButton13: TToolButton;
    cdsImport: TClientDataSet;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Panel2: TPanel;
    Splitter2: TSplitter;
    GroupBox1: TGroupBox;
    opnAddr1: TRadioButton;
    opnAddr2: TRadioButton;
    GroupBox2: TGroupBox;
    ra2: TCheckBox;
    ra1: TCheckBox;
    ra0: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    wa2: TCheckBox;
    wa1: TCheckBox;
    wa0: TCheckBox;
    Label5: TLabel;
    ComPort1: TComPort;
    GroupBox3: TGroupBox;
    ComLed1: TComLed;
    ComLed3: TComLed;
    ComLed4: TComLed;
    ComLed5: TComLed;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    cmbPort: TComComboBox;
    cmbRate: TComComboBox;
    cmbData: TComComboBox;
    cmbFlow: TComComboBox;
    cmbParity: TComComboBox;
    cmbStop: TComComboBox;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    btnUpdate: TButton;
    Reg: THMRegistry;
    procedure actHelpExecute(Sender: TObject);
    procedure actStartExecute(Sender: TObject);
    procedure actStopExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actReadExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure actWriteExecute(Sender: TObject);
    procedure actOpenExecute(Sender: TObject);
    procedure actSaveExecute(Sender: TObject);
    procedure cdsAVRBeforePost(DataSet: TDataSet);
    procedure ComPort1RxChar(Sender: TObject; Count: Integer);
    procedure btnUpdateClick(Sender: TObject);
  private
    FBuffer: PChar;
    FBufIdx: integer;
    SBuffer: PChar;
  public
    procedure OpenPort;
    procedure ClosePort;
    procedure WritePort(Buffer: Pointer; Count: Integer);
    procedure PressBuffer(Buffer: Pointer; BufferLength: Integer);
  end;
type
  TWriteCommThread = class(TThread)
  private
    FAddrType: integer;
    procedure SetAddrType(const Value: integer);
  protected
    procedure Execute; override;
  public
    property AddrType: integer read FAddrType write SetAddrType;
  end;
const
  CMDBEGIN = #27;
  CMDEND = #28;
  CMDHELP = #72;
  CMDREAD = #82;
  CMDWRITE = #87;
var
  Form1: TForm1;
  VaildWrite: PChar;
  WriteResult: Boolean;
implementation
{$R *.dfm}
const
  Convert: array[0..15] of Char = '0123456789ABCDEF';
procedure TForm1.FormCreate(Sender: TObject);
begin
  Reg.OpenKey;
  if Reg.ValueExists('Port') then cmbPort.Text := Reg.SValue['Port'];
  if Reg.ValueExists('Rate') then cmbRate.Text := Reg.SValue['Rate'];
  if Reg.ValueExists('Data') then cmbData.Text := Reg.SValue['Data'];
  if Reg.ValueExists('Flow') then cmbFlow.Text := Reg.SValue['Flow'];
  if Reg.ValueExists('Parity') then cmbParity.Text := Reg.SValue['Parity'];
  if Reg.ValueExists('Stop') then cmbStop.Text := Reg.SValue['Stop'];
  Reg.CloseKey;
  btnUpdateClick(Sender);
  GetMem(FBuffer, 4096);
  GetMem(SBuffer, 4096);
  GetMem(VaildWrite, 3);
  cdsAVR.LoadFromFile('HexTable.cds');
  cdsAVR.Open;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Reg.OpenKey;
  Reg.SValue['Port'] := cmbPort.Text;
  Reg.SValue['Rate'] := cmbRate.Text;
  Reg.SValue['Data'] := cmbData.Text;
  Reg.SValue['Flow'] := cmbFlow.Text;
  Reg.SValue['Parity'] := cmbParity.Text;
  Reg.SValue['Stop'] := cmbStop.Text;
  FreeMem(FBuffer);
  FreeMem(SBuffer);
  FreeMem(VaildWrite);
  FBufIdx := 0;
end;
procedure TForm1.actHelpExecute(Sender: TObject);
var
  Buffer: PChar;
begin
  GetMem(Buffer, 32); //命令缓冲区
  try
    Buffer[0] := CMDBEGIN; //命令开始符
    Buffer[1] := CMDHELP; //标志这条命令是要求AVR发送HELP给PC
    Buffer[2] := CMDEND; //命令结束符
    //ComPort1.Write(Buffer, 4);
    WritePort(Buffer, 4); //从串口发出命令
    Sleep(100); //等待 100ms，此间AVR会发回信息
  finally
    FreeMem(Buffer);
  end;
end;
procedure TForm1.actStartExecute(Sender: TObject);
begin
  OpenPort;
  actStart.Enabled := False;
  actStop.Enabled := True;
end;
procedure TForm1.actStopExecute(Sender: TObject);
begin
  ClosePort;
  actStart.Enabled := True;
  actStop.Enabled := False;
end;
procedure TForm1.actReadExecute(Sender: TObject);
var
  Buffer: PChar;
  Buf2: array[1..2] of Byte;
begin
  GetMem(Buffer, 32);
  try
    Buffer[0] := CMDBEGIN;
    Buffer[1] := CMDREAD;
    if opnAddr1.Checked then
      Buf2[1] := 1
    else
      Buf2[1] := 2;
    Buf2[2] := 0;
    if ra0.Checked then Buf2[2] := Buf2[2] + 2;
    if ra1.Checked then Buf2[2] := Buf2[2] + 4;
    if ra2.Checked then Buf2[2] := Buf2[2] + 8;
    BinToHex(@Buf2[1], @Buffer[2], 2); //Memory Address Type and Chip Address
    Buf2[1] := $00;
    Buf2[2] := $00;
    BinToHex(@Buf2[1], @Buffer[6], 2); //Memory Address
    Buf2[1] := $01;
    Buf2[2] := $FF;
    BinToHex(@Buf2[1], @Buffer[10], 2); //Read Count
    Buffer[14] := CMDEND;
    //Comm1.WriteCommData(Buffer, 15);
    WritePort(Buffer, 15);
  finally
    FreeMem(Buffer);
  end;
end;
procedure TForm1.PressBuffer(Buffer: Pointer; BufferLength: Integer);
var
  Buf2: pchar;
  i: integer;
  pos, pos2: integer;
  s: string;
begin
  if BufferLength > 0 then
    begin
      if (PChar(Buffer)[0] = CMDBEGIN) then FBufIdx := 0;
      if (BufferLength + FBufIdx >= 4096) then BufferLength := 4096 - FBufIdx - 1;
      CopyMemory(@FBuffer[FBufIdx], Buffer, BufferLength);
      Inc(FBufIdx, BufferLength);
      //Memo2.Text:=StrPas(FBuffer);
      if (PChar(Buffer)[BufferLength - 1]) <> CMDEND then exit;
    end;
  if (FBufIdx <= 3) then exit;
  if (FBuffer[1] = CMDHELP) then
    begin
      GetMem(Buf2, FBufIdx - 2);
      try
        CopyMemory(Buf2, @FBuffer[2], FBufIdx - 3);
        for i := 1 to FBufIdx - 3 do
          if (Buf2[i - 1] < #32) and not (Buf2[i - 1] in [#10, #13]) then
            Buf2[i - 1] := #32;
        Buf2[FBufIdx - 3] := #0;
        Memo1.Lines.Text := StrPas(Buf2);
        FBufIdx := 0;
        FillMemory(FBuffer, 4096, 0);
      finally
        FreeMem(Buf2);
      end;
    end
  else if (FBuffer[1] = CMDREAD) then
    begin
      GetMem(Buf2, FBufIdx - 2);
      SetLength(s, 2);
      try
        CopyMemory(Buf2, @FBuffer[2], FBufIdx - 3);
        Buf2[FBufIdx - 3] := #0;
        //Memo1.Lines.Add(StrPas(Buf2));
        if cdsAVR.ChangeCount > 0 then cdsAVR.CancelUpdates;
        pos := 1;
        Pos2 := 0;
        prs.Max := 256;
        prs.Min := 0;
        prs.Position := 0;
        prs.Visible := True;
        cdsAVR.FieldByName('FI').ReadOnly := False;
        for i := 1 to FBufIdx - 3 do
          begin
            if (Buf2[i - 1] <> #32) then
              begin
                if (pos <= 2) then s[Pos] := Buf2[i - 1];
                Inc(Pos);
              end
            else
              begin
                Pos := 1;
                if (pos2 = 0) then
                  cdsAVR.Append;
                cdsAVR['F' + Convert[pos2]] := s;
                Inc(pos2);
                prs.StepIt;
                if pos2 >= 16 then
                  begin
                    if cdsAVR.RecordCount < 16 then
                      cdsAVR['FI'] := Convert[cdsAVR.RecordCount] + '0:' + Convert[cdsAVR.RecordCount] + Convert[pos2 - 1];
                    Pos2 := 0;
                    cdsAVR.Post;
                  end;
              end;
          end;
        if cdsAVR.Modified then
          begin
            if cdsAVR.RecordCount < 16 then
              cdsAVR['FI'] := Convert[cdsAVR.RecordCount] + '0:' + Convert[cdsAVR.RecordCount] + Convert[pos2 - 1];
            cdsAVR.Post;
          end;
        cdsAVR.First;
        cdsAVR.FieldByName('FI').ReadOnly := True;
      finally
        FreeMem(Buf2);
        prs.Visible := False;
      end;
    end
  else if (FBuffer[1] = CMDWRITE) then
    begin
      CopyMemory(VaildWrite, @FBuffer[2], 2);
      WriteResult := True;
    end;
end;
procedure TForm1.actExitExecute(Sender: TObject);
begin
  Close;
end;
{ TWriteCommThread }
procedure TWriteCommThread.Execute;
var
  Buffer: PChar;
  Buf2: array[1..2] of Byte;
  s: string;
  Pos: integer;
  wait: integer;
begin
  with Form1 do
    if cdsAVR.Active and (cdsAVR.RecordCount > 0) then
      begin
        if cdsAVR.Modified then cdsAVR.Post;
        cdsAVR.First;
        Pos := 0;
        GetMem(Buffer, 32);
        cdsAVR.DisableControls;
        try
          //SetLength(s, 2);
          prs.Max := cdsAVR.RecordCount * 16;
          prs.Min := 0;
          prs.Position := 0;
          prs.Visible := True;
          Buffer[0] := CMDBEGIN;
          Buffer[1] := CMDWRITE;
          if opnAddr1.Checked then
            Buf2[1] := 1
          else
            Buf2[1] := 2;
          Buf2[2] := 0;
          if wa0.Checked then Buf2[2] := Buf2[2] + 2;
          if wa1.Checked then Buf2[2] := Buf2[2] + 4;
          if wa2.Checked then Buf2[2] := Buf2[2] + 8;
          BinToHex(@Buf2[1], @Buffer[2], 2); //Memory Address Type and Chip Address
          while not cdsAVR.Eof and (cdsAVR.RecNo <= 16) and not Self.Terminated and not Application.Terminated do
            begin
              if not cdsAVR.FieldByName('F' + Convert[Pos]).IsNull and
                (Length(cdsAVR.FieldByName('F' + Convert[Pos]).AsString) = 2) then
                begin
                  s := UpperCase(cdsAVR.FieldByName('F' + Convert[Pos]).AsString);
                  if not (s[1] in ['0'..'9', 'A'..'F']) then s[1] := '0';
                  if not (s[2] in ['0'..'9', 'A'..'F']) then s[2] := '0';
                  //Memory Address
                  Buffer[6] := '0';
                  Buffer[7] := '0';
                  Buffer[8] := Convert[cdsAVR.Recno - 1];
                  Buffer[9] := Convert[Pos];
                  //Memory Data
                  Buffer[10] := s[1];
                  Buffer[11] := s[2];
                  Buffer[12] := CMDEND;
                  WriteResult := False;
                  FillMemory(VaildWrite, 3, 0);
                  wait := 0;
                  WritePort(Buffer, 13);
                  while (wait < 2000) and (not WriteResult) do
                    begin
                      Inc(wait);
                      Sleep(100);
                    end;
                  if wait >= 2000 then
                    begin
                      Memo1.Lines.Add('Write EEPROM Error(Time out).');
                      Break;
                    end;
                  if WriteResult and (s[1] <> VaildWrite[0]) and (s[2] <> VaildWrite[1]) then
                    begin
                      Buffer[12] := #0;
                      Memo1.Lines.Add('Write EEPROM Error(Vaild Check Data:' + StrPas(@Buffer[2]) + ',S:' + s + ',Result:' + StrPas(VaildWrite) + ')');
                    end;
                end;
              Inc(Pos);
              prs.StepIt;
              if Pos >= 16 then
                begin
                  Pos := 0;
                  cdsAVR.Next;
                end;
            end;
          cdsAVR.First;
        finally
          FreeMem(Buffer);
          cdsAVR.EnableControls;
          prs.Visible := False;
        end;
      end;
end;
procedure TForm1.actWriteExecute(Sender: TObject);
begin
  TWriteCommThread.Create(False);
end;
procedure TForm1.actOpenExecute(Sender: TObject);
var i: integer;
  Field: TField;
begin
  if OpenDialog1.Execute then
    begin
      cdsImport.LoadFromFile(OpenDialog1.FileName);
      cdsImport.Open;
      cdsImport.First;
      if (cdsAVR.ChangeCount > 0) then cdsAVR.CancelUpdates;
      cdsAVRFI.ReadOnly := False;
      while not cdsImport.Eof do
        begin
          cdsAVR.Append;
          for i := 1 to cdsAVR.FieldCount do
            begin
              Field := cdsImport.FindField(cdsAVR.Fields[i - 1].FieldName);
              if (Field <> nil) and cdsAVR.Fields[i - 1].CanModify then
                begin
                  cdsAVR.Fields[i - 1].Value := Field.Value;
                end;
            end;
          cdsAVR.Post;
          cdsImport.Next;
        end;
      cdsImport.Close;
      cdsAVRFI.ReadOnly := True;
      cdsAVR.First;
      //cdsImport.EmptyDataSet;
    end;
end;
procedure TForm1.actSaveExecute(Sender: TObject);
begin
  if cdsAVR.Active and SaveDialog1.Execute then
    begin
      cdsAVR.SaveToFile(SaveDialog1.FileName);
    end;
end;
procedure TWriteCommThread.SetAddrType(const Value: integer);
begin
  FAddrType := Value;
end;
procedure TForm1.cdsAVRBeforePost(DataSet: TDataSet);
var
  i: integer;
  s: string;
begin
  for i := 1 to 16 do
    begin
      s := cdsAVR.FieldByName('F' + Convert[i - 1]).AsString;
      if s = '' then s := '00';
      if (s[1] in ['a'..'f']) then s[1] := Char(Byte(s[1]) - 32);
      if (s[2] in ['a'..'f']) then s[2] := Char(Byte(s[2]) - 32);
      if not (s[1] in ['0'..'9', 'A'..'F']) then s[1] := '0';
      if not (s[2] in ['0'..'9', 'A'..'F']) then s[2] := '0';
      if s <> cdsAVR.FieldByName('F' + Convert[i - 1]).AsString then
        begin
          //if not (cdsAVR.State in [dsEdit, dsInsert]) then cdsAVR.Edit;
          cdsAVR.FieldByName('F' + Convert[i - 1]).AsString := s;
        end;
    end;
end;
procedure TForm1.WritePort(Buffer: Pointer; Count: Integer);
begin
  ComPort1.Write(Buffer^, Count);
end;
procedure TForm1.OpenPort;
begin
  ComPort1.Open;
end;
procedure TForm1.ClosePort;
begin
  ComPort1.Close;
end;
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var i: integer;
begin
  if Count <= 0 then exit;
  if Count < 4096 then
    begin
      ComPort1.Read(SBuffer^, Count);
      PressBuffer(SBuffer, Count);
    end
  else
    begin
      i := Count;
      while i > 0 do
        begin
          ComPort1.Read(SBuffer^, 4096);
          PressBuffer(SBuffer, 4096);
          i := i - 4096;
        end;
    end;
end;
procedure TForm1.btnUpdateClick(Sender: TObject);
begin
  cmbPort.ApplySettings;
  cmbPort.UpdateSettings;
  cmbRate.ApplySettings;
  cmbData.ApplySettings;
  cmbFlow.ApplySettings;
  cmbParity.ApplySettings;
  cmbStop.ApplySettings;
end;
end.

						