Автоматизация отдела маркетинга, рекламы и ИТ “Завод-ВТО”

>    Button16: TButton;

    Button17: TButton;

    ListBox3: TListBox;

    Button18: TButton;

    Button19: TButton;

    Memo6: TMemo;

    OpenDialog1: TOpenDialog;

    OpenDialog2: TOpenDialog;

    btn1: TButton;

    mmom: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure Timer2Timer(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Button6Click(Sender: TObject);

    procedure Button5Click(Sender: TObject);

    procedure Button7Click(Sender: TObject);

    procedure Button8Click(Sender: TObject);

    procedure Button9Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Button10Click(Sender: TObject);

    procedure Button11Click(Sender: TObject);

    procedure Button12Click(Sender: TObject);

    procedure Button14Click(Sender: TObject);

    procedure Button15Click(Sender: TObject);

    procedure Button13Click(Sender: TObject);

    procedure Timer3Timer(Sender: TObject);

    procedure N1Click(Sender: TObject);

    procedure N3Click(Sender: TObject);

    procedure Timer4Timer(Sender: TObject);

    procedure Button16Click(Sender: TObject);

    procedure Button17Click(Sender: TObject);

    procedure Button18Click(Sender: TObject);

    procedure Button19Click(Sender: TObject);

    procedure Button20Click(Sender: TObject);

    procedure Button21Click(Sender: TObject);

    procedure Button22Click(Sender: TObject);

    procedure Button23Click(Sender: TObject);

    procedure Button24Click(Sender: TObject);

    procedure btn1Click(Sender: TObject); 

   

  private

    { Private declarations }

  public

    { Public declarations }

  end; 

type

  TWinVersion = (wvUnknown, wv95, wv98, wvME, wvNT3, wvNT4, wvW2K, wvXP); 

var

  Form1: TForm1;

  Computer: Array[1..100] of String[25];

    ComputerCount : Integer;

    MemoryStatus : TMemoryStatus;

implementation 

{$R *.dfm}

const

   DRIVER_INFORMATION = 11; 

type

   TPDWord = ^DWORD; 

   TDriverInfo = packed record

     Address: Pointer;

     Unknown1: DWORD;

     Unknown2: DWORD;

     EntryIndex: DWORD;

     Unknown4: DWORD;

     Name: array [0..MAX_PATH + 3] of Char;

   end; 

var

   NtQuerySystemInformation: function (infoClass: DWORD;

   buffer: Pointer;

   bufSize: DWORD;

   returnSize: TPDword): DWORD; stdcall = nil; 

const SHFMT_DRV_A = 0;

const SHFMT_DRV_B = 1;  

const SHFMT_ID_DEFAULT = $FFFF;

 

const SHFMT_OPT_QUICKFORMAT = 0;

const SHFMT_OPT_FULLFORMAT = 1;

const SHFMT_OPT_SYSONLY = 2;

 

const SHFMT_ERROR = -1;

const SHFMT_CANCEL = -2;

const SHFMT_NOFORMAT = -3; 

function GetDriverInfo: string;

   var

      temp, Index, numBytes, numEntries: DWORD;

     buf: TPDword;

     driverInfo: ^TDriverInfo;

   begin

     if @NtQuerySystemInformation = nil then

       NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),

         'NtQuerySystemInformation'); 

     // Obtain required buffer size

    NtQuerySystemInformation(DRIVER_INFORMATION, @temp, 0, @numBytes);

     // Allocate buffer

    buf := AllocMem(numBytes * 2); 

     NtQuerySystemInformation(DRIVER_INFORMATION, buf, numBytes * 2, @numBytes);

     numEntries := buf^;

     driverInfo := Pointer(DWORD(buf) + 12);

     Result     := '';

     for Index := 1 to numEntries do

      begin

       Result:= Result + '#0$D#0$A'+'Address: $' + IntToHex(DWORD(driverInfo^.Address), 8) +

         'Name: "' + (driverInfo^.Name) + '"'+#10+#13;

       Inc(driverInfo);

     end;

     Delete(Result, 1, 2);

     FreeMem(buf);

   end;

 

  function GetFileDate(FileName: string): string; 

var

  FHandle: Integer; 

begin

  FHandle := FileOpen(FileName, 0);

  try

    Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));

  finally

    FileClose(FHandle);

  end;

end;

function SHFormatDrive(hWnd : HWND;

                        Drive : Word;

                        fmtID : Word;

                        Options : Word) : Longint

    stdcall; external 'Shell32.dll' name 'SHFormatDrive';

function IPAddrToName(IPAddr : String): String;

var

  SockAddrIn: TSockAddrIn;

  HostEnt: PHostEnt;

  WSAData: TWSAData;

begin

  WSAStartup($101, WSAData);

  SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));

  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);

  if HostEnt<>nil then

  begin

    result:=StrPas(Hostent^.h_name)

  end

  else

  begin

    result:='';

  end;

end; 

function DoIExist(WndTitle : String) : Boolean;

var

  hSem    : THandle;

  hWndMe,

  hWndPrev : HWnd;

  semNm,

  wTtl    : Array[0..256] of Char;

begin

 

  Result := False;

 

  //Copy the Pascal strings into the Arrays of Char;

  StrPCopy(semNm, 'SemaphoreName');

  StrPCopy(wTtl, WndTitle);

 

  //Create a Semaphore in memory

  hSem := CreateSemaphore(nil, 0, 1, semNm);

 

  //Now, check to see if the semaphore exists

  if ((hSem <> 0) AND (GetLastError() = ERROR_ALREADY_EXISTS)) then begin

    CloseHandle(hSem);

 

    //We'll first get the currently executing window's handle then change its title

    //so we can look for the other instance

    hWndMe := FindWindow(nil, wTtl);

    SetWindowText(hWndMe, 'zzzzzzz');

 

    //What we want to do now is search for the other instance of this window

    //then bring it to the top of the Z-order stack.

    hWndMe := FindWindow(nil, wTtl);

    if (hWndMe <> 0) then begin

      if IsIconic(hWndMe) then

        ShowWindow(hWndMe, SW_SHOWNORMAL)

      else

        SetForegroundWindow(hWndMe);

    end;

 

    Result := True;

 

    //Could put the Halt here, instead of in the FormCreate method,

    //unless you want to do some extra processing.

 

    //Halt;

  end;

end;

 

procedure ShowDesktop(const YesNo : boolean);

var h : THandle;

begin

h := FindWindow('ProgMan', nil);

h := GetWindow(h, GW_CHILD);

if YesNo = True then

   ShowWindow(h, SW_SHOW)

else

   ShowWindow(h, SW_HIDE);

   end; 
 

procedure FindAllComputers(Workgroup: String);

Var  EnumHandle: THandle;

WorkgroupRS : TNetResource;

   Buf: Array[1..500] of TNetResource;

     BufSize:cardinal;   Entries:cardinal;

       Result      : Integer;

begin   ComputerCount := 0;

Workgroup := Workgroup + #0;

FillChar(WorkgroupRS, SizeOf(WorkgroupRS) , 0);

With WorkgroupRS do begin

dwScope := 2;

dwType := 3;

dwDisplayType := 1;

dwUsage := 2;

lpRemoteName := @Workgroup[1];

   end;

WNetOpenEnum( RESOURCE_GLOBALNET,RESOURCETYPE_ANY,0,@WorkgroupRS,EnumHandle );

Repeat

Entries := 1;

BufSize := SizeOf(Buf);

Result :=WNetEnumResource( EnumHandle,Entries,@Buf,BufSize);

If (Result = NO_ERROR) and (Entries = 1) then

  begin

  Inc( ComputerCount );

  Computer[ ComputerCount ] := StrPas(Buf[1].lpRemoteName);

  end;

  Until (Entries <> 1) or (Result <> NO_ERROR);

  WNetCloseEnum( EnumHandle );

end;  { Find All Computers }

 

function GetCurrentUserName: string;

const

   cnMaxUserNameLen = 254;

var

   sUserName: string;

   dwUserNameLen: DWORD;

begin

   dwUserNameLen := cnMaxUserNameLen - 1;

   SetLength(sUserName, cnMaxUserNameLen);

   GetUserName(PChar(sUserName), dwUserNameLen);

   SetLength(sUserName, dwUserNameLen);

   Result := sUserName;

end;

function GetComputerNetName: string;

var

  buffer: array[0..255] of char;

  size: dword;

begin

  size := 256;

  if GetComputerName(buffer, size) then

    Result := buffer

  else

    Result := ''

    end;

    procedure TForm1.Button5Click(Sender: TObject);

begin

  button4.Enabled:=true;

   memo3.Clear;

   button5.Enabled:=false;

   button6.Enabled:=false;

end; 
 

procedure TForm1.Button6Click(Sender: TObject);

begin

if savedialog1.Execute then

memo1.Lines.SaveToFile(savedialog1.FileName) ;

end; 
 
 
 

procedure TForm1.Button1Click(Sender: TObject);

const TokenSize = 800; //  (SizeOf(Pointer)=4 *200)

var

   hToken: THandle;

   pTokenInfo: PTOKENPRIVILEGES;

   ReturnLen: Cardinal;

   i: Integer;

   PrivName: PChar;

   DisplayName: PChar;

   NameSize: Cardinal;

   DisplSize: Cardinal;

   LangId: Cardinal;

begin

memo2.Lines.Clear;

edit1.text:=GetComputerNetName;

edit2.text:= GetCurrentUserName;

GetMem(pTokenInfo, TokenSize);

   if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

     hToken) then ShowMessage('OpenProcessToken error');

   if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then