Листинг программного кода

unit MainUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Controls, Forms, ComCtrls, ExtCtrls,

XPMan, ImgList, Menus, Buttons, ToolWin, Dialogs, Grids, WinProcs, RpCon,

RpConDS, RpBase, RpSystem, RpDefine, RpRave, StdCtrls, XMLIntf, msxmldom,

xmldom, XMLDoc;

{ список привелегий }

type

TPrivilege = class

Form: string;

Controls: array of string;

end;

type

TMainForm = class(TForm)

XPManifest: TXPManifest;

BtnProduct: TSpeedButton;

Image16x16: TImageList;

PanelView: TPanel;

Bevel: TBevel;

BtnOrders: TSpeedButton;

BtnContractor: TSpeedButton;

BtnOrdersPlan: TSpeedButton;

PanelMenu: TPanel;

BtnStatusesEditor: TSpeedButton;

BtnMaterialsEditor: TSpeedButton;

Image32x32: TImageList;

BoxMessages: TScrollBox;

BtnMessages: TSpeedButton;

GridMessages: TDrawGrid;

BtnReports: TSpeedButton;

MenuReports: TPopupMenu;

RepProducts: TMenuItem;

RepContractor: TMenuItem;

RvSystem: TRvSystem;

RvDataSetConnection: TRvDataSetConnection;

RvProject: TRvProject;

RepPlan: TMenuItem;

RepOrders: TMenuItem;

BtnPrivilege: TSpeedButton;

LabelUser: TLabel;

XMLDocument: TXMLDocument;

BtnNote: TBitBtn;

About: TMenuItem;

BtnLog: TSpeedButton;

LabelPost: TLabel;

LabelName: TLabel;

procedure FormCreate(Sender: TObject);

{ кнопки разделов }

procedure BtnProductClick(Sender: TObject);

procedure BtnOrdersClick(Sender: TObject);

procedure BtnOrdersPlanClick(Sender: TObject);

procedure BtnContractorClick(Sender: TObject);

procedure BtnStatusesEditorClick(Sender: TObject);

procedure BtnMaterialsEditorClick(Sender: TObject);

procedure BtnPrivilegeClick(Sender: TObject);

procedure BtnLogClick(Sender: TObject);

{ вызов сообщений }

procedure BtnMessagesMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

{ вызов меню кнопки }

procedure BtnPopupViewMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

{ отрисовка сообщений }

procedure GridMessagesDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

{ кнопки отчетов }

procedure RepPlanClick(Sender: TObject);

procedure RepOrdersClick(Sender: TObject);

procedure RepProductsClick(Sender: TObject);

procedure RepContractorClick(Sender: TObject);

{ вызов применение привелегий для главной формы }

procedure FormShow(Sender: TObject);

{ о программе }

procedure AboutClick(Sender: TObject);

private

{ Private declarations }

ListImageMessage: TStringList;

{ применение привелегий }

procedure UsePrivileges(const NameForm: string; var Reference);

{ создать форму и вывести в панели }

procedure CreateForm(InstanceClass: TComponentClass; var Reference;

const FormName: string);

{ записать в журнал }

procedure WriteLog(arraySQL: array of string);

public

{ Public declarations }

ListPrivileges: TList;

Privilege: TPrivilege;

{ выполнение запроса }

procedure ExecQuery(arraySQL:array of string);

{ переводит строку из формата Currency в Double }

procedure CurrToFloat(var fullstr: string; out Value: string);

end;

var

MainForm: TMainForm;

implementation

uses ProductsUnit, DataUnit, OrdersUnit, OrdersPlanUnit, ContractorsUnit,

StatusesEditorUnit, MaterialsEditorUnit, PlanningUnit, PrivilegeUnit,

AboutUnit, LogUnit;

{$R *.dfm}

procedure TMainForm.CurrToFloat(var fullstr: string; out Value: string);

var i, j: integer;

begin

for i:=1 to Length(fullstr) do begin

if TryStrToInt(fullstr[i],j)

then Value:=Value+IntToStr(j)

else if (fullstr[i]='.') and (i<>Length(fullstr))

then Value:=Value+'.';

end;

if Value='' then Value:='0';

end;

procedure TMainForm.CreateForm(InstanceClass: TComponentClass;

var Reference; const FormName: string);

var i:integer;

begin

If Assigned(TForm(Reference)) and (TForm(Reference).Visible) then Exit;

for i:=Application.ComponentCount-1 downto 0 do

begin

if TForm(Application.Components[i]).Parent=PanelView

then begin

TForm(Application.Components[i]).Parent:=Nil;

TForm(Application.Components[i]).Close;

end;

end;

Application.CreateForm(InstanceClass, Reference);

UsePrivileges(FormName, Reference);

TForm(Reference).ManualDock(PanelView, nil, alClient);

TForm(Reference).Show;

end;

procedure TMainForm.ExecQuery(arraySQL: array of string);

var i: integer;

begin

with DataForm do begin

try

try

for i:=0 to Length(arraySQL)-1 do begin

IBSQL.SQL.Clear;

IBSQL.SQL.Add(arraySQL[i]);

IBSQL.ExecQuery;

end;

TransControlOrders.Commit;

WriteLog(arraySQL);

except

on E: Exception do begin

Application.MessageBox(PChar(E.Message),'Ошибка',MB_OK or MB_ICONERROR);

TransControlOrders.Rollback;

end;

end;

finally

TransControlOrders.Active:=true;

end;

end;

end;

procedure TMainForm.BtnProductClick(Sender: TObject);

begin

CreateForm(TProductsForm,ProductsForm, 'ProductsForm');

end;

procedure TMainForm.FormCreate(Sender: TObject);

var hGridRect: TGridRect;

begin

hGridRect.Top:= -1;

hGridRect.Left:= -1;

hGridRect.Right:= -1;

hGridRect.Bottom:= -1;

GridMessages.Selection:= hGridRect;

DecimalSeparator:='.';

GridMessages.ColWidths[0]:=35;

ListImageMessage:=TStringList.Create;

end;

procedure TMainForm.BtnOrdersClick(Sender: TObject);

begin

CreateForm(TOrdersForm,OrdersForm,'OrdersForm');

end;

procedure TMainForm.BtnOrdersPlanClick(Sender: TObject);

begin

CreateForm(TOrdersPlanForm,OrdersPlanForm,'OrdersPlanForm');

end;

procedure TMainForm.BtnContractorClick(Sender: TObject);

begin

CreateForm(TContractorsForm,ContractorsForm,'ContractorsForm');

end;

procedure TMainForm.BtnStatusesEditorClick(Sender: TObject);

begin

Application.CreateForm(TStatusesEditorForm,StatusesEditorForm);

StatusesEditorForm.ShowModal;

end;

procedure TMainForm.BtnMaterialsEditorClick(Sender: TObject);

begin

Application.CreateForm(TMaterialsEditorForm,MaterialsEditorForm);

MaterialsEditorForm.ShowModal;

end;

procedure TMainForm.BtnMessagesMouseUp(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var p: tpoint;

i: integer;

begin

if Button=mbLeft then begin

if BoxMessages.Visible then begin

BoxMessages.Visible:=not BoxMessages.Visible;

GridMessages.Height:=0;

Exit;

end;

ListImageMessage.Clear;

with DataForm.IBDataSet do begin

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT IMPORTANCE, MESSAGES, NAME FROM '+

'V_APPLICATION_MESSAGES ORDER BY 1');

Active:=true;

First;

while not Eof do begin

ListImageMessage.AddObject(Fields[1].AsString+#13+Fields[2].AsString,

TObject(Fields[0].AsInteger));

Next;

end;

GridMessages.RowCount:=RecordCount;

Active:=false;

end;

p.x:=BtnMessages.Left;

p.Y:=BtnMessages.Top+BtnMessages.Height+PanelMenu.Top;

BoxMessages.Top:=p.Y;

BoxMessages.Left:=p.X;

p.Y:=ClientHeight-p.Y;

p.X:=ClientWidth-p.X;

BoxMessages.Width:=p.X;

BoxMessages.Height:=p.Y;

BoxMessages.Visible:=true;

GridMessages.Left:=0;

GridMessages.Top:=0;

GridMessages.Width:=BoxMessages.Width-20;

GridMessages.ColWidths[1]:=GridMessages.Width-GridMessages.ColWidths[0];

for i:=0 to GridMessages.RowCount+1 do

GridMessages.Height:=GridMessages.Height+GridMessages.RowHeights[i];

end;

end;

procedure TMainForm.GridMessagesDrawCell(Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

var Format: Word;

C: array[0..255] of Char;

textRect: TRect;

Y: integer;

begin

Y:=Rect.Top+(Rect.Bottom - Rect.Top - Image32x32.Height) div 2;

if ACol=0 then

Image32x32.Draw(GridMessages.Canvas,Rect.Left+1,Y,

Integer(ListImageMessage.Objects[ARow]));

if ACol=1 then begin

textRect.Top:=Rect.Top+1;

textRect.Left:=Rect.Left+1;

textRect.Bottom:=Rect.Bottom;

textRect.Right:=Rect.Right;

Format:= DT_LEFT or DT_WORDBREAK or DT_CALCRECT;

GridMessages.Canvas.FillRect(Rect);

StrPCopy(C, ListImageMessage[ARow]);

WinProcs.DrawTextEx(GridMessages.Canvas.Handle, C,

StrLen(C), textRect, Format, Nil);

GridMessages.RowHeights[ARow]:=textRect.Bottom-textRect.Top+1;

Format:= DT_LEFT or DT_WORDBREAK;

WinProcs.DrawTextEx(GridMessages.Canvas.Handle, C,

StrLen(C), textRect, Format, Nil);

end;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);

var i: byte;

begin

ListImageMessage.Free;

if ListPrivileges.Count>0 then

for i:=0 to ListPrivileges.Count-1 do

TPrivilege(ListPrivileges[i]).Free;

ListPrivileges.Free;

end;

procedure TMainForm.BtnPopupViewMouseUp(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var p: tpoint;

i: integer;

begin

if Button=mbLeft then begin

for i:=0 to MenuReports.Items.Count-1 do

MenuReports.Items[i].Visible:=false;

if TButton(Sender).Name='BtnNote'

then MenuReports.Items[4].Visible:=true

else begin

if Assigned(ProductsForm) then MenuReports.Items[0].Visible:=true;

if Assigned(ContractorsForm) then MenuReports.Items[1].Visible:=true;

if Assigned(PlanningForm) then MenuReports.Items[2].Visible:=true;

if Assigned(OrdersForm) then MenuReports.Items[3].Visible:=true;

end;

p.x:=TButton(Sender).Left;

p.Y:=TButton(Sender).Top+TButton(Sender).Height+PanelMenu.Top;

MenuReports.Popup(ClientToScreen(p).x,ClientToScreen(p).y);

end;

end;

procedure TMainForm.RepProductsClick(Sender: TObject);

begin

with DataForm.IBDataSet do begin

try

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT * FROM V_PRODUCT_LIST');

Active:=true;

RvProject.Open;

RvProject.SelectReport('ReportProducts',false);

RvProject.SetParam('DateReport',DateToStr(Date));

RvProject.Execute;

finally

RvProject.Close;

Active:=false;

end;

end;

end;

procedure TMainForm.RepContractorClick(Sender: TObject);

begin

with DataForm.IBDataSet do begin

try

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT * FROM CONTRACTOR');

Active:=true;

RvProject.Open;

RvProject.SelectReport('ReportContractor',false);

RvProject.Execute;

finally

RvProject.Close;

Active:=false;

end;

end;

end;

procedure TMainForm.RepPlanClick(Sender: TObject);

begin

with DataForm.IBDataSet do begin

try

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT S.NAME, OS.FINISH FROM ORDER_STATUS as OS '+

'LEFT OUTER JOIN STATUSES as S ON OS.ID_STATUS=S.ID '+

'WHERE OS.ID_ORDER_PRODUCTS='+IntToStr(PlanningForm.ID_OP)+

' and OS.FINISH is not null');

Active:=true;

RvProject.Open;

RvProject.SelectReport('ReportPlan',false);

RvProject.SetParam('DateReport',PlanningForm.EditNameOrder.Text);

RvProject.SetParam('ResourcesReport',PlanningForm.EditResources.Text);

RvProject.Execute;

finally

RvProject.Close;

Active:=false;

end;

end;

end;

procedure TMainForm.RepOrdersClick(Sender: TObject);

begin

with DataForm.IBDataSet do begin

try

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT * FROM V_ORDERS_LIST');

Active:=true;

RvProject.Open;

RvProject.SelectReport('ReportOrders',false);

RvProject.Execute;

finally

RvProject.Close;

Active:=false;

end;

end;

end;

procedure TMainForm.BtnPrivilegeClick(Sender: TObject);

begin

CreateForm(TPrivilegeForm,PrivilegeForm,'PrivilegeForm');

end;

procedure TMainForm.FormShow(Sender: TObject);

var path: string;

begin

path:=ExtractFilePath(paramstr(0))+RvProject.ProjectFile;

if not FileExists(path)

then BtnReports.Enabled:=false

else RvProject.ProjectFile:=path;

UsePrivileges('MainForm', MainForm);

end;

procedure TMainForm.UsePrivileges(const NameForm: string; var Reference);

var i, j, k: integer;

b: boolean;

begin

b:=false;

if (ListPrivileges.Count>0) then begin

for k:=0 to ListPrivileges.Count-1 do begin

if (TPrivilege(ListPrivileges[k]).Form=NameForm) then begin

b:=true;

Break;

end;

end;

end;

if not b then Exit;

with TForm(Reference) do begin

for i:=0 to Length(TPrivilege(ListPrivileges[k]).Controls)-1 do begin

for j:=ComponentCount-1 downto 0 do begin

if (Components[j] is TSpeedButton) and

(TPrivilege(ListPrivileges[k]).Controls[i]=Components[j].Name)

then begin

(Components[j] as TControl).Parent:=nil;

Components[j].Free;

Break;

end;

end;

end;

end;

end;

procedure TMainForm.AboutClick(Sender: TObject);

begin

Application.CreateForm(TAboutForm,AboutForm);

AboutForm.ShowModal;

end;

procedure TMainForm.BtnLogClick(Sender: TObject);

begin

CreateForm(TLogForm,LogForm,'LogForm');

end;

procedure TMainForm.WriteLog(arraySQL: array of string);

label l;

var Node: IXMLNode;

user, find: string;

b: boolean;

i: integer;

path: string;

begin

user:='1';

find:='2';

path:=ExtractFilePath(paramstr(0))+'log.xml';

with MainForm.XMLDocument do begin

if not FileExists(path) then begin

Active:=true;

Version:='1.0';

Encoding:='unicode';

DocumentElement:=AddChild('LOG');

end else begin

LoadFromFile(path);

Active:=true;

end;

end;

Node:=MainForm.XMLDocument.DocumentElement.ChildNodes.First;

b:=false;

l:

while (user<>find) and (Node<>nil) do begin

if Node.Attributes['POST']='' then Break;

user:=Node.Attributes['POST']+' '+Node.Attributes['NAME'];

find:=MainForm.LabelPost.Caption+' '+MainForm.LabelName.Caption;

if user<>find

then Node:=Node.NextSibling

else b:=true;

end;

if not b then begin

Node:=MainForm.XMLDocument.DocumentElement;

Node:=Node.AddChild('USER');

Node.SetAttributeNS('NAME','',MainForm.LabelName.Caption);

Node.SetAttributeNS('POST','',MainForm.LabelPost.Caption);

end;

for i:=0 to Length(arraySQL)-1 do begin

Node:=Node.AddChild('ACTION');

Node.SetAttributeNS('DATE','',DateToStr(Date));

Node.SetAttributeNS('TIME','',TimeToStr(Time));

find:=Copy(arraySQL[i],1,Pos(' ',arraySQL[i])-1);

if (find='UPDATE') and (Copy(arraySQL[i],7,10)=' OR INSERT')

then find:=find+' OR INSERT';

Node.SetAttributeNS('TYPE','',find);

Node.Text:=arraySQL[i];

Node:=Node.ParentNode;

end;

MainForm.XMLDocument.SaveToFile(path);

MainForm.XMLDocument.Active:=false;

end;

end.

unit AboutUnit;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TAboutForm = class(TForm)

PanelView: TPanel;

ProgramIcon: TImage;

ProductName: TLabel;

Version: TLabel;

Comments: TLabel;

OKButton: TButton;

CompanyName: TLabel;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AboutForm: TAboutForm;

implementation

{$R *.dfm}

procedure TAboutForm.FormCreate(Sender: TObject);

var LanguageInfo: string;

VIBuff: pointer;

VISize: cardinal;

buffsize: cardinal;

str: pchar;

trans: pointer;

temp: integer;

LangCharSet: string;

function GetStringValue(const From: string): string;

begin

VerQueryValue(VIBuff,pchar('\StringFileInfo\'+LanguageInfo+'\'+From),

pointer(str), buffsize);

if buffsize > 0

then Result:= str

else Result:= 'n/a';

end;

begin

VISize:=GetFileVersionInfoSize(PChar(Application.ExeName),buffsize);

VIBuff:=AllocMem(VISize);

GetFileVersionInfo(PChar(Application.ExeName),cardinal(0),VISize,VIBuff);

VerQueryValue(VIBuff,'\VarFileInfo\Translation',Trans,buffsize);

if buffsize >= 4 then begin

temp:=0;

StrLCopy(@temp, pchar(Trans), 2);

LangCharSet:=IntToHex(temp, 4);

StrLCopy(@temp, pchar(Trans)+2, 2);

LanguageInfo:= LangCharSet+IntToHex(temp, 4);

end;

ProductName.Caption:=GetStringValue('ProductName');

CompanyName.Caption:=CompanyName.Caption+GetStringValue('CompanyName');

Version.Caption:=Version.Caption+GetStringValue('ProductVersion');

Comments.Caption:=GetStringValue('Comments');

FreeMem(VIBuff,VISize);

end;

end.

unit AuthorizationUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Mask, Buttons, XMLIntf, wcrypt2;

type

TAuthorizationForm = class(TForm)

BtnOK: TBitBtn;

BtnCancel: TBitBtn;

OpenDialog: TOpenDialog;

EditPass: TMaskEdit;

LabelPass: TLabel;

LabelFile: TLabel;

EditFile: TEdit;

BtnSelectFile: TSpeedButton;

{ выбрать файл }

procedure BtnSelectFileClick(Sender: TObject);

{ проверка привелегий }

procedure FormClose(Sender: TObject; var Action: TCloseAction);

{ вернуть mrOK }

procedure BtnOKClick(Sender: TObject);

procedure BtnCancelClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AuthorizationForm: TAuthorizationForm;

implementation

uses MainUnit;

{$R *.dfm}

procedure TAuthorizationForm.BtnSelectFileClick(Sender: TObject);

begin

if OpenDialog.Execute

then EditFile.Text:=OpenDialog.FileName;

end;

procedure TAuthorizationForm.FormClose(Sender: TObject;

var Action: TCloseAction);

var Node, NodeChild: IXMLNode;

i, j: integer;

Value: AnsiString;

Stream:TMemoryStream;

Prov: HCRYPTPROV;

Hash: HCRYPTHASH;

Key: HCRYPTKEY;

DataLen: DWORD;

begin

MainForm.ListPrivileges:=TList.Create;

if ModalResult=mrCancel then begin

Application.Terminate;

Exit;

end;

Stream:=TMemoryStream.Create;

Stream.LoadFromFile(OpenDialog.FileName);

{ расшифровка }

CryptReleaseContext(Prov,0);

CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,CRYPT_VERIFYCONTEXT);

CryptCreateHash(Prov,CALG_SHA,0,0,@Hash);

CryptHashData(Hash,PByte(EditPass.Text),Length(EditPass.Text),0);

CryptDeriveKey(Prov,CALG_RC2,Hash,0,@Key);

CryptDeriveKey(Prov, CALG_RC2, Hash, 0, @Key);

DataLen:= stream.Size;

CryptDecrypt(Key, 0, true, 0, PByte(stream.Memory), @DataLen);

Stream.Seek(0, soFromBeginning);

CryptDestroyKey(Key);

CryptDestroyHash(Hash);

{ удаление остаточных символов }

i:=0;

SetLength(Value, Integer(Stream.Size));

Stream.ReadBuffer(Pointer(Value)^, Length(Value));

j:=Length(Value);

repeat

if Value[j]<>'>' then Inc(i);

Dec(j);

until Value[j]='>';

Stream.SetSize(Stream.Size-i+1);

{ проверка файла }

MainForm.XMLDocument.LoadFromStream(Stream, xetUnknown);

Stream.Free;

Node:=MainForm.XMLDocument.DocumentElement.ChildNodes['general'].ChildNodes.First;

if StrToDate(Node.Text)<Date then begin

Application.MessageBox('Срок действия файла истек'+#13+

'Получите новую версию файла','Ошибка авторизации'

, MB_OK or MB_ICONERROR);

Application.Terminate;

Exit;

end;

Node:=Node.NextSibling;

MainForm.LabelPost.Caption:=Node.GetAttributeNS('post','');

MainForm.LabelName.Caption:=Node.Text;

Node:=Node.ParentNode.NextSibling.ChildNodes.First;

with MainForm do begin

ListPrivileges:=TList.Create;

{ сохранение привелегий }

while (Node<>nil) do begin

Privilege:=TPrivilege.Create;

Privilege.Form:=Node.NodeName;

NodeChild:=Node.ChildNodes.First;

while NodeChild<>nil do begin

SetLength(Privilege.Controls,Length(Privilege.Controls)+1);

Privilege.Controls[Length(Privilege.Controls)-1]:=NodeChild.NodeName;

NodeChild:=NodeChild.NextSibling;

end;

Node:=Node.NextSibling;

ListPrivileges.Add(Privilege);

end;

end;

Action:=caFree;

AuthorizationForm:=nil;

MainForm.XMLDocument.Active:=false;

end;

procedure TAuthorizationForm.BtnOKClick(Sender: TObject);

begin

if FileExists(OpenDialog.FileName) then ModalResult:=mrOK;

end;

procedure TAuthorizationForm.BtnCancelClick(Sender: TObject);

begin

ModalResult:=mrCancel;

end;

end.

unit ContractorUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, Buttons;

const

WM_CONTROL_ORDERS = WM_USER+1;

type

TContractorForm = class(TForm)

EditName: TEdit;

LabelName: TLabel;

LabelAddress: TLabel;

EditAddress: TEdit;

LabelPhone: TLabel;

EditPhone: TEdit;

BtnOK: TBitBtn;

BtnCancel: TBitBtn;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

{ выявление типа создаваемой формы }

procedure ViewTypeForm(var Message: TMessage);

message WM_CONTROL_ORDERS;

public

{ Public declarations }

end;

var

ContractorForm: TContractorForm;

implementation

uses DataUnit, MainUnit, ContractorsUnit;

{$R *.dfm}

procedure TContractorForm.FormClose(Sender: TObject;

var Action: TCloseAction);

var arraySQL: array [0..0] of string;

begin

if (ModalResult=idOK) and (EditName.Text<>'') then begin

arraySQL[0]:='UPDATE OR INSERT INTO CONTRACTOR (ID, NAME, ADDRESS, '+

'TELEPHONE) VALUES (';

if Tag<>0

then arraySQL[0]:=arraySQL[0]+IntToStr(Tag)

else arraySQL[0]:=arraySQL[0]+'null';

arraySQL[0]:=arraySQL[0]+','''+EditName.Text+''',';

if EditAddress.Text<>''

then arraySQL[0]:=arraySQL[0]+''''+EditAddress.Text+''','

else arraySQL[0]:=arraySQL[0]+'null,';

if EditPhone.Text<>''

then arraySQL[0]:=arraySQL[0]+''''+EditPhone.Text+''')'

else arraySQL[0]:=arraySQL[0]+'null)';

arraySQL[0]:=arraySQL[0]+' MATCHING(ID)';

MainForm.ExecQuery(arraySQL);

end;

ContractorsForm.BtnRefresh.Click;

ContractorForm:=nil;

Action:=caFree;

end;

procedure TContractorForm.ViewTypeForm(var Message: TMessage);

begin

if Message.LParam<>2 then Exit;

with DataForm.IBDataSet do begin

Caption:='Изменить данные о заказчике';

Active:=false;

SelectSQL.Clear;

SelectSQL.Add('SELECT ID, NAME, ADDRESS, TELEPHONE FROM CONTRACTOR '+

'WHERE ID='+IntToStr(Message.WParam));

Active:=true;

First;

ContractorForm.Tag:=Fields[0].AsInteger;

EditName.Text:=Fields[1].AsString;

EditAddress.Text:=Fields[2].AsString;

EditPhone.Text:=Fields[3].AsString;

Active:=false;

end;

end;

end.

Date: 2016-05-25; view: 1222; Нарушение авторских прав