3.4 Расчет цены разработки
Для определения минимальной цены, ниже которой разработчику будет невыгодно продавать ПП, используется следующая формула (6):
,
(6)
где
- цена программного продукта, руб;
-
себестоимость программного продукта,
руб;
-
норматив прибыли (5%).
10286,4
* (1+0,05) = 10800,72 руб.
3.5 Экономическая эффективность
Использование
программы позволит уйти лишних операций
контроллера, что позволит упростить
алгоритм работы контроллера, а это в
свою очередь 
увеличит
время отклика системы, повысит
стабильность, уменьшит вероятность
сбоев. Специалисты смогут быстрее
проверять работу системы. А также даст
возможность отгружать продукцию на
склад без задержек.
Заключение
В процессе прохождения преддипломной практики был сделан выбор языка и среды программирования, операционной системы для разрабатываемого программного обеспечения. Рассмотрены вопросы безопасности жизнедеятельности при работе с вычислительной техникой, и вопросы экономики производства.
Литература
-
Благодатских В.А. и др. Стандартизация разработки программных средств. Учеб. пособие- М.: Финансы и статистика,2003
-
Жданов С.А.. Основы теории экономического управления предприятием – М.: Финпресс, 2000г.
-
Расчёт экономической эффективности проводимых мероприятий. Методические рекомендации к курсовой работе по дисциплине “Экономика и управление предприятием” Автор: Шумова Е.В.– Череповец: Череповецкий Металлургический колледж, 2001г.
-
Шепеленко Г.И. Экономика, организация и планирование производства на предприятии. Автор:– М., 2001.
-
Волков О.И. Экономика предприятия. – Москва, 1998г.
-
Архангельский А.Я. Delphi 7. Справочное пособие – М.: ООО «Бином-Пресс», 2003 г. – 1024 с.: ил.
-
Иванова Г.С. Технология программирования: Учебник для вузов. – 2-е изд., стереотип. – М.: Изд-во МГТУ им. Н.Э. Баумана, 2003. – 320 с.: ил.
-
Хомоненко А.Д. Delphi 7/Под общ. Ред. А.Д. Хомоненко. – СПб.: БХВ – Петербург, 2004. – 1216 с.: ил.
Приложение
А- Алгоритм
работы программы
Приложение Б- Алгоритм процедуры соединения с контроллером
Приложение
В- Алгоритм
процедуры чтения данных
Приложение Г- Листинг программы
program TransferData;
uses
Windows,
SysUtils,
Messages,
Forms,
Dialogs,
UnSendData in 'UnSendData.pas' {fmMain},
UnAdd in 'UnAdd.pas',
UnClass in 'UnClass.pas',
UnPrepStr in 'UnPrepStr.pas';
{$R *.RES}
var Hnd : THandle;
begin
Hnd := FindWindow ('TfmMain', 'Передача данных из PLC');
if (Hnd = 0) {and (PrmCnt = 0)} then begin
Application.Initialize;
fmMain := TfmMain.Create(nil);
try repeat
application.HandleMessage;
application.ProcessMessages;
until application.Terminated;
finally
fmMain.free;
end;
end
end.
unit UnAdd;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
procedure WriteLog (aMes : string; aFileName : string; aStoryLOg : Integer; aNeedDT : Boolean);
implementation
procedure DelLogFile (aPath : string; aTime : integer) ;
var SrFile : TSearchRec;
L : integer;
St : TSystemTime;
begin
DateSeparator := '/';
try L := FindFirst(aPath + '*.*', faAnyFile, SrFile);
While L = 0 do begin
IF SrFile.Name[1] <> '.' then begin
FileTimeToSystemTime (SrFile.FindData.ftCreationTime, ST);
If SystemTimeToDateTime(St) < Date - aTime
Then DeleteFile (aPath + SrFile.Name);
end;
L := FindNext (SrFile);
end;
FindClose (SrFile);
except
end;
end;
procedure WriteLog (aMes : string; aFileName : string; aStoryLOg : Integer; aNeedDT : Boolean);
var TmpList : TStringList;
begin
if not DirectoryExists(ExtractFilePath (aFileName)) then ForceDirectories (ExtractFilePath (aFileName));
if not DirectoryExists(ExtractFilePath (aFileName)) then exit;
if not FileExists (aFileName) then begin закрываем дискриптор
FileClose (FileCreate (aFileName));
DelLogFile (ExtractFilePath (aFileName), aStoryLOg);
end;
if not FileExists (aFileName) then exit;
TmpList := TStringList.Create;
try TmpList.LoadFromFile (aFilename);
If aNeedDT then TmpList.Add(DateTimeTostr (now) + #32 + aMes)
else TmpList.Add(aMes);
TmpList.SaveToFile (aFileName);
finally TmpList.Free; TmpList := nil;
end;
end;
end.
unit UnClass;
interface
uses Windows, Messages, sysUtils, Classes, Math, dialogs, controls, forms, UnAdd;
type tpTag= (tpBit, tpByte, tpWord, tpSmallInt, tpDWord, tpDInt, tpsingle, tpDateTime);
type
TTag = class
private
fOffset : integer;
fBit : integer;
fTyp : tpTag;
fOwner : tList;
fValue : string;
fField: string;
protected
public
constructor Create (aOwner : tlist);
destructor Destroy; override;
property Offset : integer read fOffset write fOffset;
property Bit : integer read fBit write fBit;
property Typ : tpTag read fTyp write fTyp;
Function GetValue (aNeedReverse : Boolean; aMem : PbyteArray) : string;
property Value : string read fValue write fValue;
property Field: string read fField write fField;
end;
type
TItem = class
private
fList : TList;
fOwner : tList;
fName : string;
fTable : string;
fSize : integer;
fValues : PByteArray;
protected
function GetCount : integer;
function GetTag (aIdx : integer) : tTag;
public
constructor Create (aOwner : TList);
destructor Destroy; override;
property Count : integer read GetCount;
property Tags[Index : integer] : tTag read GetTag; default;
function AddTag (aOffset, abit : integer; aTyp : tpTag; aField : string): integer;
procedure DelTag (aIdx : integer);
procedure Clear;
property Name : string read fName write fName;
property Table : string read fTable write fTable;
property Size : integer read fSize write fSize;
property Values : PByteArray read fValues;
end;
type
TItemList = class
private
fList : TList;
protected
function GetCount : integer;
function GetItem (aIdx : integer) : TItem;
public
constructor Create;
destructor Destroy; override;
property Count : integer read GetCount;
property Items[Index : integer] : TItem read GetItem; default;
function AddItem (aName : string; aTable : string; aSize : integer): integer;
procedure DelItem (aIdx : integer);
procedure Clear;
end;
implementation
constructor
tTag.Create (aOwner : tlist);
begin
fOwner := aOwner;
if aOwner <> nil then aOwner.Add (self);
end;
destructor tTag.Destroy;
begin
If fOwner <> nil then fOwner.Remove (self);
inherited Destroy;
end;
Function TTag.GetValue (aNeedReverse : Boolean; aMem : PbyteArray) : string;
var PB : PByte;
PW : PWord;
PDW : PDWord;
PS : PSingle;
Tmp: Integer;
DW : LongInt;
S : single;
W1, W2 : Word;
Ar : array [0..3] of byte;
Year, Month, Day : byte;
Hour, Min, Sec : byte;
D : Tdate;
T : Ttime;
DT: tDatetime;
begin
DecimalSeparator := '.';
case Integer (fTyp) of
0 : begin PB := @aMem[Offset];
(exp(fOffset * Ln (2))));
tmp := trunc(POWER (2, Bit));
If PB^ and tmp = tmp then Result := '1'
else Result := '0';
end;
1 : begin PB := @aMem[Offset];
Result := IntToStr (PB^);
end;
2 : begin PW :=
@aMem[Offset];
If aNeedReverse then Result := IntToStr (swap (Word(PW^))) else
Result := IntToStr (Word(PW^));
end;
3 : begin PW := @aMem[Offset];
If aNeedReverse then Result := IntToStr (SmallInt (swap (PW^))) else
Result := IntToStr (SmallInt(PW^));
end;
4 : begin PDW := @aMem[Offset];
If aNeedReverse then begin
DW := DWord(PDW^);
W1 := swap (LongRec (DW).Lo);
W2 := swap (LongRec (DW).Hi);
LongRec (DW).Hi := W1;
LongRec (DW).Lo := W2;
Result := IntToStr (DWord (DW));
end else Result := IntToStr (DWord(PDW^));
end;
5 : begin PDW := @aMem[Offset];;
If aNeedReverse then begin
DW := DWord(PDW^);
W1 := swap (LongRec (DW).Lo);
W2 := swap (LongRec (DW).Hi);
LongRec (DW).Hi := W1;
LongRec (DW).Lo := W2;
Result := IntToStr (DW);
end else Result := IntToStr (PDW^);
end;
6 : begin PDW := @aMem[Offset];;
If aNeedReverse then begin
DW := DWord(PDW^);
W1 := swap (LongRec (DW).Lo);
W2 := swap (LongRec (DW).Hi);
LongRec (DW).Hi := W1;
LongRec (DW).Lo := W2;
Move (DW, S, 4);
Result := FloatToStr (S);
end else Result := FloatToStr (PS^);
try Result := FloatToStr ((trunc (StrToFloat (Result) * 100)) *0.01);
except Result := '0';
end;
end;
7 : begin PB := @aMem[Offset];
Year := PB^;
PB :=
@aMem[Offset + 1];
Month := PB^ + 1;
PB := @aMem[Offset + 2];
Day := PB^;
PB := @aMem[Offset + 3];
Hour := PB^;
PB := @aMem[Offset + 4];
Min := PB^;
PB := @aMem[Offset + 5];
Sec := PB^;
Result := '';
+ IntToStr (Day));
(Sec));
+ 1900, Month, Day)));
try Result := (DateToStr (EncodeDate (Year + 1900, Month, Day)) + #32 +
TimeToStr (EncodeTime (Hour, Min, Sec, 0)));
except on e : exception do begin
UnAdd.WriteLog (e.Message + #32 +
'Year = ' + IntToStr (Year) + #32 +
'Month = ' + IntToStr (Month) + #32 +
'Day = ' + IntToStr (Day) + #32 +
'Hour = ' + IntToStr (Hour) + #32 +
'Min = ' + IntToStr (Min) + #32 +
'Sec = ' + IntToStr (Sec)
, ExtractFilePath (application.exeName) + 'Log\' + formatDateTime ('ddmmyy', date) + '.Log', 30, True);
Result := '';
end;
end;
end;
end;
end;
constructor TItem.Create (aOwner : TList);
begin
fOwner := aOwner;
fList := tList.Create;
if fOwner <> nil then fowner.add (self);
end;
destructor TItem.Destroy;
begin
Clear;
If fOwner <> nil then fOwner.Remove (self);
If FList <> nil then begin
FList.free;
flist := nil;
end;
freemem (fValues, size);
inherited Destroy;
end;
function TItem.AddTag (aOffset, abit : integer; aTyp : tpTag; aField : string): integer;
var Tag : TTag;
begin
Tag := TTag.Create (fList);
tag.Offset := aOffset;
tag.Bit := aBit;
tag.Typ := aTyp;
tag.Field := aField;
end;
procedure TItem.DelTag (aIdx : integer);
begin
tTag (FList[aIdx]).Free;
end;
procedure TItem.Clear;
begin
While fList.Count <> 0
do DelTag (0);
end;
function TItem.GetCount : integer;
begin
Result := FList.Count;
end;
function TItem.GetTag (aIdx : integer) : tTag;
begin
Result := TTag (FList[aIdx]);
end;
constructor TItemList.Create;
begin
FList := TList.Create;
end;
destructor TItemList.Destroy;
begin
Clear;
if Flist <> nil then begin
FList.free;
flist := nil;
end;
inherited Destroy;
end;
function TItemList.AddItem (aName : string; aTable : string; aSize : integer): integer;
var Item : tItem;
begin
Item := tItem.Create (FList);
Item.Name := aName;
Item.Table := aTable;
Item.Size := aSize;
Getmem (Item.fValues, aSize);
end;
procedure TItemList.DelItem (aIdx : integer);
begin
TItem (FList[aIdx]).Free;
end;
procedure TItemList.Clear;
begin
While FList.Count > 0 do delItem (0);
end;
function TItemList.GetCount : integer;
begin
Result := FList.Count;
end;
function TItemList.GetItem (aIdx : integer) : TItem;
begin
Result := tItem (fList[aIdx]);
end;
end.
unit UnPrepStr;
interface
uses Windows, sysUtils, Classes, UnClass, S7_Api;
procedure PrepareItem;
implementation
uses UnSendData;
procedure PrepareItem;
var Temp : S7_READ_PARA;
i, j : integer;
begin
If DataStr = nil then exit;
DataStr.AddItem ('M10.3', '', 1);
ItemRed[0].var_name := 'M10.3';
DataStr[0].AddTag (0, 0, tpByte, '');
DataStr.AddItem ('DB16,INT8,33', 'kp.tekU4', 66);
ItemRed[1].var_name := 'DB16,INT8,33';
DataStr[1].AddTag (0, 0, tpWord, 'VK');
DataStr[1].AddTag (2, 0, tpDWord, 'PLAVKA');
DataStr[1].AddTag (6, 0,
tpSmallInt, 'NPS');
DataStr[1].AddTag (8, 0, tpsingle, 'L');
DataStr[1].AddTag (12, 0, tpsingle, 'V');
DataStr[1].AddTag (16, 0, tpSmallInt, 'NSK');
DataStr[1].AddTag (18, 0, tpSmallInt, 'NPK');
DataStr[1].AddTag (20, 0, tpSmallInt, 'SPK');
DataStr[1].AddTag (22, 0, tpSmallInt, 'NZAM');
DataStr[1].AddTag (24, 0, tpSmallInt, 'TPK1');
DataStr[1].AddTag (26, 0, tpsingle, 'DL1');
DataStr[1].AddTag (30, 0, tpSmallInt, 'TPK2');
DataStr[1].AddTag (32, 0, tpsingle, 'DL2');
DataStr[1].AddTag (36, 0, tpSmallInt, 'TPK3');
DataStr[1].AddTag (38, 0, tpsingle, 'DL3');
DataStr[1].AddTag (42, 0, tpSmallInt, 'TPK4');
DataStr[1].AddTag (44, 0, tpsingle, 'DL4');
DataStr[1].AddTag (48, 0, tpSmallInt, 'TPK5');
DataStr[1].AddTag (50, 0, tpsingle, 'DL5');
DataStr[1].AddTag (54, 0, tpSmallInt, 'TPK6');
DataStr[1].AddTag (56, 0, tpsingle, 'DL6');
DataStr[1].AddTag (60, 0, tpDateTime, 'Begin_Melt');
DataStr.AddItem ('DB17,INT8,21', 'kp.v2u4', 42);
ItemRed[2].var_name := 'DB17,INT8,21';
DataStr[2].AddTag (0, 0, tpWord, 'VK');
DataStr[2].AddTag (2, 0, tpDInt, 'PLAVKA');
DataStr[2].AddTag (6, 0, tpSmallInt, 'NPS');
DataStr[2].AddTag (8, 0, tpsingle, 'L');
DataStr[2].AddTag (12, 0,tpsingle, 'V');
DataStr[2].AddTag (16, 0,tpSmallInt, 'TPK');
DataStr[2].AddTag (18, 0,tpSmallInt, 'PR');
DataStr[2].AddTag (20, 0,tpsingle, 'DL1');
DataStr[2].AddTag (24, 0,tpsingle, 'DL2');
DataStr[2].AddTag (28, 0,tpWord, 'NSL');
DataStr[2].AddTag (30, 0,tpsingle, 'LSER');
DataStr[2].AddTag (34, 0,tpDateTime, 'Begin_Melt');
DataStr[2].AddTag (40, 0,tpWord, 'F_K');
DataStr.AddItem ('DB18,DINT2,13', 'kp.rezu4', 56);
ItemRed[3].var_name := 'DB18,DINT2,14';
DataStr[3].AddTag (0, 0,
tpDInt, 'PLAVKA');
DataStr[3].AddTag (4, 0, tpSmallInt, 'NPS');
DataStr[3].AddTag (14, 0, tpSmallInt, 'NSL');
DataStr[3].AddTag (16, 0, tpsingle, 'LMER');
DataStr[3].AddTag (20, 0, tpsingle, 'LZAD');
DataStr[3].AddTag (24, 0, tpsingle, 'LOTR');
DataStr[3].AddTag (28, 0, tpsingle, 'LZADMGR');
DataStr[3].AddTag (32, 0, tpsingle, 'LBELT');
DataStr[3].AddTag (36, 0, tpsingle, 'LSER');
DataStr.AddItem ('DB400,W20', '', 2);
ItemRed[4].var_name := 'DB400,W20';
DataStr[4].AddTag (0, 0, tpWord, '');
Temp.access := S7_ACCESS_SYMB_ADDRESS;
Temp.index := 0;
Temp.subindex := 0;
Temp.address_len := 0;
For i := 0 to High (ItemRed) do begin
ItemRed[i].access := Temp.access;
ItemRed[i].index := Temp.index;
ItemRed[i].subindex := Temp.subindex;
ItemRed[i].address_len := Temp.address_len;
end;
for i := 0 to dataStr.Count - 1 do begin
DataStr1.AddItem (dataStr[i].name, dataStr[i].Table, dataStr[i].size);
For j := 0 to dataStr[i].Count - 1 do begin
dataStr1[i].AddTag (dataStr[i][j].Offset, dataStr[i][j].bit, dataStr[i][j].Typ, dataStr[i][j].Field);
end;
end;
end;
end.
unit UnSendData;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry,
UnAdd, ComCtrls, Tabs, StdCtrls, Spin, Buttons, ExtCtrls, Db, OracleData,
Oracle, Menus, PGTray95, S7_Api, unClass, UnPrepStr;
const MsgID = 1500;
type TByteArray = array [0..(MaxInt div 2) - 1] of Byte;
PByteArray = ^TByteArray;
type TWordArray = array [0..(MaxInt div 2) - 1] of Word;
PWordArray = ^TWordArray;
type TDWordArray = array [0..(MaxInt div 4) - 1] of DWord;
PDWordArray = ^TDWordArray;
type TPArray = array [0..(MaxInt div 4) - 1] of Pointer;
PPArray = ^TPArray;
type
TfmMain = class(TForm)
Notebook1: TNotebook;
OracleSession1: TOracleSession;
OracleLogon1: TOracleLogon;
OracleDataSet1: TOracleDataSet;
StatusBar1: TStatusBar;
Timer1: TTimer;
PGTrayIcon951: TPGTrayIcon95;
PopupMenu1: TPopupMenu;
SHOW1: TMenuItem;
RUN1: TMenuItem;
STOP1: TMenuItem;
EXIT1: TMenuItem;
Panel1: TPanel;
SpeedButton4: TSpeedButton;
Memo1: TMemo;
Label9: TLabel;
Button1: TButton;
Timer2: TTimer;
Button2: TButton;
Timer3: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
procedure SpeedButton4Click(Sender: TObject);
procedure SHOW1Click(Sender: TObject);
procedure RUN1Click(Sender:
TObject);
procedure STOP1Click(Sender: TObject);
procedure EXIT1Click(Sender: TObject);
procedure PGTrayIcon951DblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
private
public
procedure WriteReg;
procedure ReadReg;
procedure ToLog (ames : string);
procedure ToSQL (ames : string);
procedure Stop;
procedure Start;
function SetLinkWithOracle : boolean;
Function CheckConnection : Boolean;
procedure Mes (var Msg : TMessage); message MsgID;
procedure S7Connect;
function InitiateReq (Idx : integer) : integer;
Procedure OnInitiateReq (aCref : word);
procedure ReadData (S7PARAM : Array of S7_READ_PARA; Count, OrdID : Word; aCref : integer);
function OnAbortInd (aCref : word) :integer;
procedure OnMultiRead (OrderId : Word);
procedure CloseAll (aCref : integer);
procedure PrepareData (OrderId : integer);
function SendData (qStr : string) : boolean;
function LogOnToOra : boolean;
end;
var
fmMain: TfmMain;
const iIntAttemp = 360;
var btRun, btClose, OraConn, bRunNow : Boolean;
iLogStory, iSQLStory : integer;
sOraName, sOraUser,sOraPwd : string;
DevName, VfdName : string;
ConnName : array [0..1] of
string;
ConnRef : array [0..1] of word;
Cp_Descr, hWnd : integer;
State : array [0..1] of Boolean;
DataStr, DataStr1 : TItemList;
ItemRed : array [0..4] of S7_READ_PARA;
OldRezCount : array [0..1] of Integer ;
S7InitOK : Boolean = FAlse;
implementation
procedure TfmMain.Mes (var Msg : TMessage);
var Cref, OrderID : word;
res : integer;
begin
res := s7_receive (cp_descr, Cref, OrderID);
case res of
S7_INITIATE_CNF : OnInitiateReq (Cref);
S7_ABORT_IND : OnAbortInd (Cref);
S7_MULTIPLE_READ_CNF : OnMultiRead (OrderId);
end;
if res = S7_ERR then
ToLog (' receive ' + IntToStr (res) + s7_last_detailed_err_msg);
end;
procedure TfmMain.FormCreate(Sender: TObject);
var i : integer;
begin
Caption := 'Передача данных из PLC';
Hwnd := FindWindow ('TfmMain', 'Передача данных из PLC');
Notebook1.PageIndex := 0;
STOP1.Enabled := False;
sOraName := '';
sOraUser := '';
sOraPwd := '';
iLogStory := 30;
iSQLStory := 30;
OldRezCount[0]:= 0;
OldRezCount[1]:= 0;
PGTrayIcon951.Animation.Icons.Add (ExtractFilePath (application.exename)+ 'icon1.ico');
PGTrayIcon951.Animation.Icons.Add
(ExtractFilePath (application.exename)+ 'icon2.ico');
PGTrayIcon951.Animation.Icons.Add (ExtractFilePath (application.exename)+ 'icon3.ico');
try ReadReg;
except
end;
bRunNow := true;
If bRunNow then ToLog ('Запуск приложения и начало работы')
else ToLog ('Запуск приложения. Работа в стопе.');
DecimalSeparator := '.';
DevName := 'S7ONLINE';
VfdName := 'Application';
ConnName[0] := 'S7';
ConnName[1] := 'S71';
OracleSession1.LogonDatabase := sOraName;
OracleSession1.LogonUsername := sOraUser;
OracleSession1.LogonPassword := sOraPwd;
PGTrayIcon951.Active := True;
PGTrayIcon951.State := tsDisabled;
DataStr := TItemList.Create;
DataStr1 := TItemList.Create;
PrepareItem;
IF abs (GetTickCount) < 250000 then Timer3.Enabled := True
else begin
SetLinkWithOracle;
IF s7_mini_db_set (S7_MINI_DB_INIT_REQ_PDU_SIZE, PChar('960')) <> S7_OK then
toLog ('s7_mini_db_set = ' + s7_last_detailed_err_msg)
else toLog ('s7_mini_db_set = S7_OK');
S7Connect;
end;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
begin
OracleDataSet1.Close;
OracleSession1.LogOff;
If DataStr <> nil then begin
DataStr.Free;
DataStr := nil;
end;
If DataStr1 <> nil then begin
DataStr1.Free;
DataStr1 := nil;
end;
end;
procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If btClose then begin
WriteReg;
ToLog ('Приложение закрыто');
Application.Terminate;
end;
If (MessageDlg ('Закончить работу приложения?', mtConfirmation, mbOKCancel, 0) = mrOk) then begin
btClose := True;
If btRun then begin
Action := caNone;
end else begin
WriteReg;
toLog ('Приложение закрыто');
Application.Terminate;
end;
end else begin
Visible := False;
end;
end;
function TfmMain.SetLinkWithOracle : boolean;
begin
Result := False;
OracleSession1.LogonDatabase := sOraName;
OracleSession1.LogonUsername := sOraUser;
OracleSession1.LogonPassword := sOraPwd;
try OracleSession1.LogOn;
sOraName := OracleSession1.LogonDatabase;
sOraUser := OracleSession1.LogonUsername;
sOraPwd := OracleSession1.LogonPassword;
Result := True;
OracleSession1.AutoCommit := True;
OraConn := True;
StatusBar1.Panels[0].Text := 'Связь с БД установлена';
except On E : Exception do begin
OraConn := False;
StatusBar1.Panels[0].Text := 'Связь с БД - ошибка';
end;
end;
end;
function TfmMain.LogOnToOra : boolean;
begin
Result := False;
if OracleLogon1.Execute and CheckConnection then
begin
sOraName := OracleSession1.LogonDatabase;
sOraUser := OracleSession1.LogonUsername;
sOraPwd := OracleSession1.LogonPassword;
Result := True;
OracleSession1.AutoCommit := True;
OraConn := True;
StatusBar1.Panels[0].Text := 'Связь с БД установлена';
end;
IF not CheckConnection then begin
OraConn := False;
StatusBar1.Panels[0].Text := 'Связь с БД - ошибка';
end;
end;
Function TfmMain.CheckConnection : Boolean;
begin
Result:= False;
IF OracleSession1 = nil then exit;
try If OracleSession1.CheckConnection (False) = ccOk then begin
Result := True;
OraConn := True;
end else begin
Result := False;
OraConn := False;
end;
except Result := false;
end;
end;
procedure TfmMain.ReadReg;
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_CONFIG;
IF not Reg.KeyExists ('Software\TransferData\') then begin
ToLog ('Ошибка чтения настроек');
exit;
end;
If not Reg.OpenKey ('Software\TransferData\', False) then begin
ToLog ('Ошибка чтения настроек');
exit;
end;
iLogStory := Reg.ReadInteger ('iLogStory');
iSQLStory := Reg.ReadInteger ('iSQLStory');
bRunNow := Reg.ReadBool ('bRunNow');
sOraName := Reg.ReadString ('sOraName');
sOraUser := Reg.ReadString ('sOraUser');
sOraPwd := Reg.ReadString ('sOraPwd');
OldRezCount[0]:= Reg.ReadInteger ('iOldRezCount1');
OldRezCount[1]:= Reg.ReadInteger ('iOldRezCount2');
finally Reg.CloseKey;
Reg.Free;
end;
end;
procedure TfmMain.WriteReg;
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_CONFIG;
If not Reg.OpenKey ('Software\TransferData\', True) then begin
ToLog ('Ошибка записи настроек');
exit;
end;
Reg.WriteInteger ('iLogStory', iLogStory);
Reg.WriteInteger ('iSQLStory', iSQLStory);
Reg.WriteBool ('bRunNow', bRunNow);
Reg.WriteString
('sOraName', sOraName);
Reg.WriteString ('sOraUser', sOraUser);
Reg.WriteString ('sOraPwd', sOraPwd);
Reg.WriteInteger ('iOldRezCount1', OldRezCount[0]);
Reg.WriteInteger ('iOldRezCount2', OldRezCount[1]);
Reg.CloseKey;
Reg.Free;
end;
procedure TfmMain.ToLog (ames : string);
begin
Memo1.Lines.Add (DateTimeToStr (now) + #32 + aMes);
while Memo1.Lines.Count > 5000 do Memo1.Lines.Delete (0);
UnAdd.WriteLog (aMes, ExtractFilePath (application.exeName) + 'Log\' + formatDateTime ('ddmmyy', date) + '.Log', iLogStory, True);
Label9.Caption := ExtractFilePath (application.exeName) + 'Log\' + formatDateTime ('ddmmyy', date) + '.Log';
end;
procedure TfmMain.ToSQL (ames : string);
begin
UnAdd.WriteLog (aMes, ExtractFilePath (application.exeName) + 'SQL\' + formatDateTime ('ddmmyy', date) + '.sql', iSQLStory, False);
end;
procedure TfmMain.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
Notebook1.PageIndex := NewTab;
end;
procedure TfmMain.SpeedButton4Click(Sender: TObject);
begin
If SpeedButton4.down then Start
else Stop;
end;
procedure TfmMain.Start;
begin
ToLog ('Старт');
WriteReg;
btRun := True;
SpeedButton4.Down := True;
RUN1.Enabled := False;
STOP1.Enabled := True;
Timer1.Enabled := True;
PGTrayIcon951.State := tsAnimated;
end;
procedure TfmMain.Stop;
begin
btRun := False;
timer1.Enabled := False;
ToLog ('Ñòîï');
SpeedButton4.Down := False;
RUN1.Enabled := True;
STOP1.Enabled := False;
If btClose then Close;
PGTrayIcon951.State := tsDisabled;
end;
procedure TfmMain.SHOW1Click(Sender: TObject);
begin
Visible := True;
end;
procedure TfmMain.RUN1Click(Sender: TObject);
begin
Start;
end;
procedure TfmMain.STOP1Click(Sender: TObject);
begin
Stop;
end;
procedure TfmMain.EXIT1Click(Sender: TObject);
begin
Close;
end;
procedure TfmMain.PGTrayIcon951DblClick(Sender: TObject);
begin
Visible := true;
end;
procedure TfmMain.S7Connect;
var res, i : integer;
begin
res := s7_init (pchar (DevName), pchar (VFDName), Cp_Descr);
S7InitOK := True;
iF res <> S7_OK then begin
ToLog ('S7_Init = ' + IntToStr (res) + #32 + s7_last_detailed_err_msg);
S7InitOK := False;
exit;
end;
ToLog ('S7_Init = ' + IntToStr (res));
res := s7_set_window_handle_msg (Cp_Descr, hWnd, msgID);
iF res <> S7_OK then begin
ToLog ('S7_set_window_handle_msg = ' + IntToStr (res) + #32 + s7_last_detailed_err_msg);
exit;
end;
ToLog ('S7_set_window_handle_msg = ' + IntToStr (res));
For i := 0 to 1 do begin
res := s7_get_cref (cp_descr, PChar (ConnName[i]), ConnRef[i]);
if res <> S7_OK then begin
ToLog (ConnName[i] + #32 + 'S7_get_cref = ' + IntToStr (res) + #32 + s7_last_detailed_err_msg);
end;
ToLog (ConnName[i] + #32 + 'S7_get_cref = ' + IntToStr (res) + ' Cref = ' + IntToStr (Connref[i]));
InitiateReq (i);
end;
end;
function TfmMain.InitiateReq (idx : integer): integer;
begin
result := s7_initiate_req (cp_descr, connref[idx]);
if result <> S7_OK then
begin
ToLog (ConnName[idx] + #32 + 'S7_initiate_req = ' + IntToStr (result) + #32 + s7_last_detailed_err_msg);
end else begin
ToLog (Connname[idx] + #32 + 'S7_initiate_req = ' + IntToStr (result));
end;
end;
Procedure TfmMain.OnInitiateReq (aCref : word);
var Ch : PChar;
begin
if s7_get_initiate_cnf = S7_OK then begin
State [aCref]:= True;
ToLog (ConnName[aCref] + #32 + 's7_get_initiate_cnf = S7_OK');
Ch := s7_mini_db_get (S7_MINI_DB_INIT_CNF_PDU_SIZE);
ToLog ('s7_mini_db_get S7_MINI_DB_INIT_CNF_PDU_SIZE = ' + Ch);
if bRunNow then Start;
StatusBar1.Panels[aCref + 1].Text := 'Связь с PLC' + IntToStr (aCref + 1) + ' установлена';
end else begin
s7_shut (cp_descr);
ToLog (' Cref = ' + IntToStr (aCref)+ #32 + 's7_get_initiate_cnf = ' + s7_last_detailed_err_msg);
StatusBar1.Panels[aCref + 1].Text := 'Связь с PLC' + IntToStr (aCref + 1) +' отсутствует';
end;
end;
procedure TfmMain.ReadData (S7PARAM : Array of S7_READ_PARA; Count, OrdID : Word; aCref : integer);
var P1 : Pointer;
res : integer;
begin
P1 := @S7PARAM[0];
res := s7_multiple_read_req (cp_descr, aCref, OrdID, Count, P1);
if res <> S7_OK then begin
ToLog (IntToStr (aCref) + ' s7_multiple_read_req ' + IntTOStr (res) + s7_last_detailed_err_msg);
exit;
end;
end;
function
TfmMain.OnAbortInd (aCref : word) :integer;
begin
Timer1.Enabled := False;
ToLog ('On Abort Ind Cref');
result := s7_get_abort_ind ();
if result <> S7_OK then ToLog ('On Abort Ind Cref = ' + s7_last_detailed_err_msg)
else ToLog ('On Abort Ind = S7_OK');
State[aCref] := False;
StatusBar1.Panels[aCref + 1].Text := 'Обрыв Связи с PLC'+ IntToStr (aCref + 1) ;
Timer2.Enabled := true;
end;
procedure TfmMain.OnMultiRead (OrderId : Word);
var i: integer;
res : integer;
Sz, Offset : integer;
LenAr : PWordArray;
ResAr : PWordArray;
VAlAr : PByteArray;
PVal : PPArray;
begin
Offset := 0; sz := 0;
GetMem (LenAr, (High (ItemRed) + 1) * 2);
GetMem (ResAr, (High (ItemRed) + 1) * 2);
For i := 0 to DataStr.Count - 1 do
sz := sz + DataStr[i].Size;
GetMem (ValAr, sz);
GetMem (PVal, (High (ItemRed) + 1) * 4);
For i := 0 to dataStr.Count - 1 do begin
LenAr^[i] := dataStr[i].Size;
PVal^[i] := Pointer(Integer(ValAr) + offset);
Offset := Offset + LenAr[i];
end;
res := s7_get_multiple_read_cnf (nil, ResAr, LenAr, PVal^);
IF res <> S7_OK then begin
ToLog (Connname [OrderId - 1]+ ' s7_get_multiple_read_cnf = ' + s7_last_detailed_err_msg);
end else begin
If OrderId = 1 then begin
Offset := 0;
For i := 0 to dataStr.Count - 1 do begin
System.Move (Pointer (Integer (ValAr) + Offset)^, Pointer (Integer (DataStr[i].Values))^, DataStr[i].size);
Offset := Offset + DataStr[i].size;
end;
end;
If OrderId = 2 then begin
Offset := 0;
For i := 0 to dataStr1.Count - 1 do begin
System.Move (Pointer (Integer (ValAr) + Offset)^, Pointer (Integer (DataStr1[i].Values))^, DataStr1[i].size);
Offset := Offset + DataStr1[i].size;
end;
end;
PrepareData (OrderId - 1);
end;
FreeMem (LenAr, (High (ItemRed) + 1) * 2);
FreeMem (ResAr, (High (ItemRed) + 1) * 2);
freeMem (ValAr, sz);
FreeMem (PVal, (High (ItemRed) + 1) * 4);
end;
procedure TfmMain.CloseAll (aCref : integer);
var res : integer;
begin
res := s7_shut (cp_descr);
if res <> S7_Ok then ToLog ('s7_shut Not Ok')
else begin
Timer1.Enabled := False;
State [aCref] := False;
StatusBar1.Panels[aCref + 1].Text := 'Связь с PLC отсутствует';
end;
end;
procedure
TfmMain.Timer1Timer(Sender: TObject);
var i : integer;
begin
Timer1.Enabled := false;
If btClose then begin
btRun := false;
Close;
exit;
end;
For i := 0 to 1 do begin
if State[i] then Readdata (ItemRed, Datastr.Count, i + 1 , ConnRef[i]);
end;
Timer1.Enabled := true;
end;
procedure TfmMain.PrepareData (OrderId : integer);
var i : integer;
Data : TItemList;
s : string;
NewCount : word;
begin
DecimalSeparator := '.';
If OrderId = 0 then Data := DataStr;
If OrderId = 1 then Data := DataStr1;
If data = nil then exit;
If data[0].Values^[0] = 0 then exit;
with data[1] do begin
s:= 'update ' + data[1].Table + ' set tt=' +
'to_date (' + #39 + formatDateTime ('DD-MM-YY HH:NN:SS', now) + #39 + ', ' +
#39 + 'DD-MM-YY HH24:MI:SS' + #39 + '), ' +
'Ru=' + InttoStr (OrderId + 7) + ', ';
for i := 0 to Count -1 do begin
Tags[i].Value := Tags[i].GetValue (true, Values);
if (tags[i].Typ = tpDateTime) and (Length (tags[i].Value) > 0) then
s := S + Tags[i].Field + '=' +
'to_date (' + #39 + formatDateTime ('DD-MM-YY HH:NN:SS', StrToDAteTime(Tags[i].Value)) + #39 +
', ' + #39 + 'DD-MM-YY
HH24:MI:SS' + #39 + '), '
else s := S + Tags[i].Field + '=' + Tags[i].Value + ', ';
end;
s := System.Copy (s, 1, length (s) - 2);
s := S + ' where ID=' + InttoStr (OrderId + 1);
SendData (s);
end;
with data[2] do begin
s:= 'insert into ' + data[2].Table + '(tt, ru,';
For i := 0 to Count -1 do s := s + Tags[i].Field + ', ';
s := copy (s, 1, Length (s) - 2);
s := s + ') values (' +
'to_date (' + #39 + formatDateTime ('DD-MM-YY HH:NN:SS', now) + #39 + ', ' +
#39 + 'DD-MM-YY HH24:MI:SS' + #39 + '), ' +
InttoStr (OrderId + 7) + ', ';
for i := 0 to Count -1 do begin
Tags[i].Value := Tags[i].GetValue (true, Values);
if (tags[i].Typ = tpDateTime) and (Length (tags[i].Value) > 0) then
s := S + 'to_date (' + #39 + formatDateTime ('DD-MM-YY HH:NN:SS', StrToDAteTime(Tags[i].Value)) + #39 +
', ' + #39 + 'DD-MM-YY HH24:MI:SS' + #39 + '), '
else s := S + Tags[i].Value + ', ';
end;
s := System.Copy (s, 1, length (s) - 2);
s := S + ')';
SendData (s);
end;
with data[4] do begin
for i := 0 to Count -1 do
Tags[i].Value := Tags[i].GetValue (true, Values);
NewCount := StrToInt (Tags[0].Value);
end;
If NewCount <>
OldRezCount[OrderId] then begin
with data[3] do begin
s:= 'insert into ' + Table + '(tt, nr,';
For i := 0 to Count -1 do s := s + Tags[i].Field + ', ';
s := s + 'cnt) values (' +
'to_date (' + #39 + formatDateTime ('DD-MM-YY HH:NN:SS', now) + #39 + ', ' +
#39 + 'DD-MM-YY HH24:MI:SS' + #39 + '), ' +
InttoStr (OrderId + 7) + ', ';
for i := 0 to Count -1 do begin
Tags[i].Value := Tags[i].GetValue (true, Values);
s := S + Tags[i].Value + ', ';
end;
S := s + IntToStr (NewCount) + ')';
SendData (s);
end;
OldRezCount[OrderId] := NewCount;
end;
end;
function TfmMain.SendData (qStr : string) : boolean;
begin
result := false;
If not btRun then exit;
try With OracleDataSet1 do begin
CloseAll;
Sql.Clear;
SQL.Add (QStr);
Active := True;
Result := True;
end;
except On E : exception do begin
Screen.Cursor := crdefault;
ToLog ('Ошибка при обращении к ораклу ' + E.Message);
ToSQL (qStr + ';');
CheckConnection;
Result := False;
end;
end;
end;
procedure TfmMain.Button1Click(Sender: TObject);
begin
SetLinkWithOracle;
end;
procedure TfmMain.Timer2Timer(Sender: TObject);
begin
Timer2.Enabled := false;
IF State[0] and State[1] then exit;
If not State[0] then InitiateReq (0);
If not State[1] then InitiateReq (1);
Timer2.Enabled := True;
end;
procedure TfmMain.Button2Click(Sender: TObject);
begin
OracleSession1.LogOff;
LogOnToOra;
end;
procedure TfmMain.Timer3Timer(Sender: TObject);
begin
Timer3.Enabled := False;
If GetTickCount > 250000 then begin
SetLinkWithOracle;
IF s7_mini_db_set (S7_MINI_DB_INIT_REQ_PDU_SIZE, PChar('960')) <> S7_OK then
toLog ('s7_mini_db_set = ' + s7_last_detailed_err_msg)
else toLog ('s7_mini_db_set = S7_OK');
S7Connect;
end else Timer3.Enabled := True;
end;
end.