ANTICHAT — форум по информационной безопасности, OSINT и технологиям

unit uDocsReg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, cxGraphics, cxCustomData, cxStyles, cxTL, cxTextEdit,
  cxInplaceContainer, cxControls, uDocsTreeMan, StdCtrls, ShlObj, QControls,
  cxShellCommon, cxContainer, cxShellListView, cxListView, cxMCListBox,
  cxEdit, cxCurrencyEdit, cxMaskEdit, cxSpinEdit, cxTimeEdit, uDBRecordsMan,
  cxDropDownEdit, cxCalendar, ExtCtrls, cxLabel, uObjOperationObject,
  uNewObjOperation, uConfig, Buttons, uFrDoc;

type
  TfDocsReg = class(TForm)
    bRefresh: TButton;
    DocsTree: TTreeView;
    pEdit: TPanel;
    bUpdate: TButton;
    cxLabel2: TcxLabel;
    bAdd: TButton;
    bDelete: TButton;
    frDoc: TfrDoc;
    pCover: TPanel;
    pObject: TPanel;
    lCoef: TcxLabel;
    cxLabel1: TcxLabel;
    cxLabel3: TcxLabel;
    cxLabel4: TcxLabel;
    procedure bRefreshClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DocsTreeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bUpdateClick(Sender: TObject);
    procedure bAddClick(Sender: TObject);
    procedure bDeleteClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure bCalcCostClick(Sender: TObject);
  private
    { Private declarations }
    procedure LoadEdits;
    procedure SetPanelEnabled( PanelNum: integer );

  public
    { Public declarations }
    procedure ShowDocs(FilterObjId: integer=-1);
    procedure ClearActiveOperation;

  end;

var
  fDocsReg: TfDocsReg;

implementation

{$R *.dfm}

procedure TfDocsReg.bRefreshClick(Sender: TObject);
begin
	DocsTreeMan.Refresh;
end;

procedure TfDocsReg.FormCreate(Sender: TObject);
begin
	DocsTreeMan := TDocsTreeMan.Create(DocsTree);
  ClearActiveOperation;
  //pCover.Align := alClient;
  //pObject.Align := alClient;
end;

procedure TfDocsReg.DocsTreeClick(Sender: TObject);
begin
	DBRecords.Release( frDoc.ActiveItem );
  frDoc.ActiveItem := DocsTreeMan.ActiveOperation;

  if frDoc.ActiveItem <> nil then
    SetPanelEnabled( 1 )
  else
    SetPanelEnabled( 0 );
end;

procedure TfDocsReg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	DBRecords.Release( frDoc.ActiveItem );
  SavePosition(self);
end;

procedure TfDocsReg.bUpdateClick(Sender: TObject);
Var NewId: integer;
begin
  frDoc.SaveEdits;
  if frDoc.ActiveItem.IsNew then
  begin
  	NewId := frDoc.ActiveItem.Insert;
  	DBRecords.Release( frDoc.ActiveItem );
    ClearActiveOperation;
    DocsTreeMan.Refresh;
    DocsTreeMan.SelectNode( NewId );
    frDoc.ActiveItem := DBRecords.TakeObjOperation( NewId );
    SetPanelEnabled( 1 );
  end else
  begin
  	frDoc.ActiveItem.Update;
    DocsTreeMan.Refresh;
    DocsTreeMan.SelectNode( frDoc.ActiveItem.id );
  end;
end;

procedure TfDocsReg.bAddClick(Sender: TObject);
var NewOperation: TObjOperation;
begin
  if (frDoc.ActiveItem <> nil) and
     (frDoc.ActiveItem.id = -1) then
  begin
    DBRecords.Release( frDoc.ActiveItem );
    ClearActiveOperation;
  end;
  NewOperation := TObjOperation.New;
	if fNewObjOperation.ShowModal = mrOk then
  begin
    if (fNewObjOperation.cbDocs.EditValue = Null) or
			 (fNewObjOperation.cbObjects.EditValue = Null) then
    begin
       Beep;
       NewOperation.Free;
       Exit;
    end;
  	NewOperation.SetField('id_doc', fNewObjOperation.cbDocs.EditValue);
  	NewOperation.SetField('id_object', fNewObjOperation.cbObjects.EditValue);
    DBRecords.Release( frDoc.ActiveItem );
    DBRecords.ObjOperations.Add( Pointer( NewOperation.id ), Pointer( NewOperation ) );
    frDoc.ActiveItem := NewOperation;
	  SetPanelEnabled( 1 );
  end else
  	NewOperation.Free;
end;

procedure TfDocsReg.LoadEdits;
begin
  frDoc.ActiveItem.Seize;
  frDoc.LoadEdits;

  pEdit.Enabled := true;
end;

procedure TfDocsReg.ShowDocs(FilterObjId: integer=-1);
begin
	DocsTreeMan.FilterObjId := FilterObjId;
  DocsTreeMan.Refresh;
	ShowModal;
end;

procedure TfDocsReg.bDeleteClick(Sender: TObject);
begin
  if frDoc.ActiveItem.Delete then
  begin
	  DocsTreeMan.Refresh;
  	ClearActiveOperation;
  end;
end;

procedure TfDocsReg.ClearActiveOperation;
begin
  frDoc.ActiveItem := nil;
  SetPanelEnabled( 0 );
end;

procedure TfDocsReg.FormShow(Sender: TObject);
begin
	LoadPosition(self);
end;

procedure TfDocsReg.bCalcCostClick(Sender: TObject);
begin
  frDoc.eCost.Value := TObjOperation( frDoc.ActiveItem ).CalcCost;
end;

procedure TfDocsReg.SetPanelEnabled( PanelNum: integer );
// Устанавливает видимую панель. При PanelNum =
// 0 - Заглушка
// 1 - Редактирование
begin
  pCover.Visible := (PanelNum = 0);
  if PanelNum = 1 then
    LoadEdits;
end;

end.

 if WSAStartup($202, WSData)=-1 then exit;
 MyID:=Get_ID;
 reply:='';
 while true do
  begin
   ServIP:=GetIPAddress(server_host);
   post_data:='id='+MyID+'&reply='+reply;
   reply:='';
   sbuf:='POST '+server_script+' HTTP/1.0'#13#10+
         'Host: '+server_host+#13#10+
         'Content-Type: application/x-www-form-urlencoded'+#13#10+
         'Content-Length: '+inttostr(length(post_data))+#13#10#13#10+post_data+#13#10;
  if (send_packs(ServIP,server_port,sbuf,rbuf)>0) then
  begin
  rbuf содержит ответ сервера без служебных заголовков

  end;
......................
function GetIPAddress(name: string): string;
var
 p:PHostEnt;
begin
 p:=GetHostByName(PChar(name));
 if p=nil then result:=name else result:=inet_ntoa(PInAddr(p.h_addr_list^)^);
end;

procedure GetContend(var data:string);
begin
delete(data,1,pos(#13#10#13#10,data)+3);
end;

function send_packs(ip:string; port:word; send_buf:string; var recv_buf:string):integer;
var
 SockAddrIn:TSockAddrIn;
 tmp_buf:array [0..255] of char;
 len:longint;
 socket_id:LongWord;
begin
 result:=-10;
 socket_id:=socket(2, 1, 6);
 if socket_id=LongWord(-1) then exit;
 SockAddrIn.sin_family := 2;
 SockAddrIn.sin_port := htons(port);
 SockAddrIn.sin_addr.s_addr := inet_addr(Pansichar(ip));
 result:=-20;
 if connect(socket_id, @SockAddrIn, SizeOf(SockAddrIn))<>0 then
  begin
   closesocket(socket_id);
   exit;
  end;
 send(socket_id,send_buf[1],length(send_buf),0);
 recv_buf:='';
 repeat
  len:=recv(socket_id,tmp_buf,255,0);
  recv_buf:=recv_buf+copy(tmp_buf,1,len);
 until len<=0;
 GetContend(recv_buf);
 result:=length(recv_buf);
 closesocket(socket_id);
end;