[Fransuz_F]

Есть код программы, нужно реализовать эту программу в реальность. Форумчане помогите новичку

Код:

unit U_Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,strUtils, iniFiles, Buttons;
 
type
  TReadThread = class(TThread)
     private
     protected
     procedure Execute; override;
     end;
 
 
 
 
 
type
  TFm_Main = class(TForm)
    Panel1: TPanel;
    Ed_Ch1: TEdit;
    Label1: TLabel;
    Ed_Ch2: TEdit;
    Label2: TLabel;
    Tm_Reg: TTimer;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    Tm_Read: TTimer;
    ComboBox1: TComboBox;
    Label8: TLabel;
    Label7: TLabel;
    Label6: TLabel;
    Bevel1: TBevel;
    Label9: TLabel;
    Tm_Screen: TTimer;
    Label10: TLabel;
    Ed_Ch3: TEdit;
    Bevel2: TBevel;
    Bevel3: TBevel;
    SpeedButton2: TSpeedButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Ed_Ch4: TEdit;
    Ed_Ch5: TEdit;
    Ed_Ch6: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Tm_RegTimer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Tm_ReadTimer(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Tm_ScreenTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
const
Count_Ch=6;
Time_delay=50;
 
 
var
  Fm_Main: TFm_Main;
  DCB   : TDCB;
  CT:  TCommTimeouts;
  hPort : THandle;
  RegFile:TFileStream;
  ReadThread:TReadThread;
  NamePatch:String;
  ByteWritten,ByteReaded:dword;
  RegStart:boolean=false;
  ReadByte:array [0..255] of char;
  Value:array[0..16] of string;
  RegFileName,StrFile:string;
  str,s:string;
  tick:integer=0;
  tick_reg:integer=0;
  INI:TIniFile;
  Path:string;
  RSPort:string;
  Cycle:integer;
 
 
implementation
 
{$R *.dfm}
 
function parse_date_time(str:string):string;
  begin
  if(length(str) = 1) then
    result:='0'+ str
   else
    result:=str;
  end;
 
 
 
function DeleteLineBreaks(const S: string): string;
var
  Source, SourceEnd: PChar;
begin
  Source := Pointer(S);
  SourceEnd := Source + Length(S);
  while Source < SourceEnd do
  begin
    case Source^ of
      #10: Source^ :=#32;
      #13: Source^ :=#32;
    end;
    Inc(Source);
  end;
  Result := S;
end;
 
Function DeleteProbel(s: string): string;
var
  i, n, L : integer;
  st:string;
begin
  for i := 1 To length(s) do
  begin
    n:=pos('  ',s);
    If n<>0 Then
     begin
      Delete(s,n,2);
      n:=0;
     end;
    n:=pos(' ',s);
    If n<>0 Then
     begin
      Delete(s,n,1);
      n:=0;
     end;
   end;
   Result:=s;
end;
 
 
procedure StartRead;
begin
ReadThread:=TReadThread.Create(True);
 with ReadThread do begin
  Priority:=tpNormal;
  FreeOnTerminate:=True;
  Resume;
 end
end;
 
Procedure Create_RegFile;
begin
RegFileName:='Micron_'+datetostr(now)+'.csv';
if FileExists(RegFileName) Then
  begin
     RegFile := TFileStream.Create(RegFileName,fmOpenWrite or fmShareDenyRead);
     RegFile.Seek(0,soFromEnd);
  end
  else
  begin
   RegFile:=TFileStream.Create(RegFileName, fmCreate or fmOpenReadWrite or fmShareDenyNone);
   StrFile:=StrFile+'Время;SW;LW;RTO;WT;Alarm;Dtemp;';
   //          SW    LW    RTO   WT   Alarm   Dtemp
   StrFile:= StrFile +#13+#10;
   RegFile.Write(PChar(StrFile)^, Length(StrFile));
  end;
end;
 
 
 
Procedure Write_RegFile;
var
str:string;
i:integer;
Min, Hour, Sec, Msec: word;
begin
DecodeTime(Now, Hour, Min, Sec,Msec);
StrFile:='';
StrFile:=StrFile+parse_date_time(IntToStr(Hour))+':'+parse_date_time(IntToStr(Min))+':'+parse_date_time(IntToStr(Sec))+'.'+parse_date_time(IntToStr(Msec))+';'
+Value[1]+';'+Value[2]+';'+Value[3]+';'+Value[4]+';'+Value[5]+';'+Value[6]+';';
StrFile:= StrFile +#13;
RegFile.Write(PChar(StrFile)^, Length(StrFile));
end;
 
procedure clr_com;
begin
{PurgeComm(hPort,PURGE_TXCLEAR);
PurgeComm(hPort,PURGE_RXCLEAR);
PurgeComm(hPort,PURGE_RXABORT);
PurgeComm(hPort,PURGE_TXABORT);}
PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
str:='';
s:='';
end;
 
Function Init_Device():boolean;
begin
 NamePatch:=ExtractFilePath('..\');
 hPort := CreateFile(PChar(RSPort),GENERIC_READ + GENERIC_WRITE,0, nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 if hPort = INVALID_HANDLE_VALUE then
 begin
 exit;
 end;
 if not GetCommState(hPort, DCB) then ShowMessage('Ошибка чтения настроек порта') else
  begin
  DCB.BaudRate :=CBR_19200;
  DCB.ByteSize :=8;
  DCB.StopBits :=ONESTOPBIT;
  DCB.Parity   :=0;
 
 
 
   if not SetCommState(hPort, DCB) then  ShowMessage('Ошибка записи настроек порта');
   CT.ReadTotalTimeoutConstant:=80;
   CT.ReadIntervalTimeout := 80;
   CT.ReadTotalTimeoutMultiplier :=80;
   CT.WriteTotalTimeoutMultiplier := 80;
   CT.WriteTotalTimeoutConstant := 80;
   If Not SetCommTimeouts(hPort, CT) Then ShowMessage('Ошибка конфигурации таймаутов !!!');
   if not SetupComm(hPort, 2048, 2048) then ShowMessage('Ошибка записи настроек буферов порта');
   if PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR) then  ;
  end;
 
 
 
 
 
Result:=True;
Fm_Main.Tm_Read.Interval:=Cycle;
Fm_Main.Tm_Read.Enabled:=True;
 
end;
 
Procedure TReadThread.Execute;
var
index:integer;
i:integer;
s1:string;
ch:byte;
begin
 
     clr_com;
     str:='';
     str:='яяM01R001'+#13; // Получить данные со всех каналов с устройства с адресом 01
     WriteFile(hPort,pchar(str)^,Length(Str),ByteWritten,Nil);
     ReadFile(hport,ReadByte,SizeOf(ReadByte),ByteReaded,Nil);
     s:=ReadByte;
     s:=DeleteLineBreaks(s);
     s:=DeleteProbel(s);
 
 
 
     Value[1]:=MidStr(s,7,5);
     Value[2]:=MidStr(s,12,5);
     Value[3]:=MidStr(s,17,5);
     Value[4]:=MidStr(s,22,5);
     Value[5]:=MidStr(s,27,5);
     Value[6]:=MidStr(s,33,5);
 
//яяM01R001 -запрос
//01R001100001000000982000000000000020 - ответ
//01 R001 10000 10000 00982 00000 00000  00020
//          SW    LW    RTO   WT   Alarm   Dtemp
 
 
end;
 
 
procedure TFm_Main.FormCreate(Sender: TObject);
begin
Path:=GetCurrentDir;
INI := TIniFile.Create(Path+'\Settings.ini');
RSPort:=INI.ReadString('Main','Rsport','COM1');
Cycle:=INI.ReadInteger('Main','Cycle',1000);
Init_Device;
Create_RegFile;
SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
Label10.Caption:='Период регистрации';
end;
 
procedure TFm_Main.Tm_RegTimer(Sender: TObject);
begin
If RegStart Then
begin
Write_RegFile;
inc(tick_reg);
Label8.Caption:='Регистрация: '+IntToStr(tick_reg);
end;
 
end;
 
procedure TFm_Main.SpeedButton1Click(Sender: TObject);
begin
If SpeedButton1.Down Then
begin
RegStart:=True;
SpeedButton1.Font.Color:=clRed;
SpeedButton1.Caption:='ОСТАНОВИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
end
Else
begin
RegStart:=False;
SpeedButton1.Font.Color:=clGreen;
SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
end;
end;
 
procedure TFm_Main.Tm_ReadTimer(Sender: TObject);
begin
inc(tick);
Label7.Caption:='Опрос Micron: '+IntToStr(tick);
StartRead;
end;
 
procedure TFm_Main.ComboBox1Change(Sender: TObject);
begin
Case ComboBox1.ItemIndex Of
0: Tm_Reg.Interval:=100;
1: Tm_Reg.Interval:=500;
2: Tm_Reg.Interval:=1000;
3: Tm_Reg.Interval:=5000;
4: Tm_Reg.Interval:=10000;
5: Tm_Reg.Interval:=30000;
6: Tm_Reg.Interval:=60000;
7: Tm_Reg.Interval:=300000;
8: Tm_Reg.Interval:=1000000;
 
end;
end;
 
function after(const Search, Find: string): string;
var
 
  index: byte;
begin
 
  index := Pos(Find, Search);
  if index = 0 then
    Result := ''
  else
    Result := Copy(Search, index + Length(Find), 255);
end;
 
 
procedure TFm_Main.Tm_ScreenTimer(Sender: TObject);
begin
Fm_Main.Ed_Ch1.Text:=Value[1];
Fm_Main.Ed_Ch2.Text:=Value[2];
Fm_Main.Ed_Ch3.Text:=Value[3];
Fm_Main.Ed_Ch4.Text:=Value[4];
Fm_Main.Ed_Ch5.Text:=Value[5];
Fm_Main.Ed_Ch6.Text:=Value[6];
end;
 
end.