X-Program ПО, новости сайта и программирование в Delphi7 ***C наступающим праздником допогие подписчики!***

Выпуск №24

О нас: www.X-Program.narod.ru (Наш сайт. Последнее обновление - 12.12.2004); http://xbase.banerka.ru/?xprogram (Наша гостевая книга); http://narod.yandex.ru/userforum/?owner=x-program (Наш форум по Delpi7) X-Program@narod. ru (Наш EMail. Присылайте свои вопросы). http://www.delphi-faq.fatal.ru (Сайт наших друзей)

Сегодня в выпуске: 1 - Как запускать мою программу на каждом старте Windows 2 - Вопросы подписчиков 3 - Как принять файлы, брошенные на мою форму по drag & drop 4 - Как переслать файл в Мусорную Корзину

Как запускать мою программу на каждом старте Windows uses  Registry, {For Win32}  IniFiles; {For Win16}  {$IFNDEF WIN32}  const MAX_PATH = 144;  {$ENDIF}  {For Win32}  procedure TForm1.Button1Click(Sender: TObject);  var  reg: TRegistry;  begin  reg := TRegistry.Create;  reg.RootKey := HKEY_LOCAL_MACHINE;  reg.LazyWrite := false;  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',  false);  reg.WriteString('My App', Application.ExeName);  reg.CloseKey;  reg.free;  end;  {For Win16}  procedure TForm1.Button2Click(Sender: TObject);  var  WinIni : TIniFile;  WinIniFileName : array[0..MAX_PATH] of char;  s : string;  begin  GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));  StrCat(WinIniFileName, '\win.ini');  WinIni := TIniFile.Create(WinIniFileName);  s := WinIni.ReadString('windows',  'run',  '');  if s = '' then  s := Application.ExeName else  s := s + ';' + Application.ExeName;  WinIni.WriteString('windows',  'run',  s);  WinIni.Free;  end;

Вопросы подписчиков Вопрос №1 Здравствуйте, X-Program. Привет. Может, кому-нибудь из читателей, удалось написать утилиту, показывающую все активные TCP/IP соединения (аналог Netstat) на Delphi без использования Fnugry Netstat Components. Поделитесь пожалуйста исходником, а то дядька Google мне отказался с этим помочь. Ответить Ответ №1 Нет ответа Вопрос №2 Здравствуйте, X-Program. как сделать индикатор загрузки процессора в % как в диспетчере задач? перерыл кучу всяких факов и конференций, но ничего не нашел. Помогите плиз.......Ответить Ответ №2 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Gauges, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Gauge1: TGauge; Timer1: TTimer; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} const  SystemBasicInformation = 0; SystemPerformanceInformation = 2; SystemTimeInformation = 3;  type TPDWord = ^DWORD;  TSystem_Basic_Information = packed record dwUnknown1: DWORD;  uKeMaximumIncrement: ULONG;  uPageSize: ULONG; uMmNumberOfPhysicalPages: ULONG;  uMmLowestPhysicalPage: ULONG;  uMmHighestPhysicalPage: ULONG; uAllocationGranularity: ULONG;  pLowestUserAddress: Pointer;  pMmHighestUserAddress: Pointer; uKeActiveProcessors: ULONG;  bKeNumberProcessors: byte;  bUnknown2: byte; wUnknown3: word;  end;  type  TSystem_Performance_Information = packed record liIdleTime: LARGE_INTEGER; {LARGE_INTEGER} dwSpare: array[0..75] of DWORD;  end;  type  TSystem_Time_Information = packed record  liKeBootTime: LARGE_INTEGER; liKeSystemTime: LARGE_INTEGER;  liExpTimeZoneBias: LARGE_INTEGER;  uCurrentTimeZoneId: ULONG; dwReserved: DWORD;  end;  var  NtQuerySystemInformation: function(infoClass: DWORD;  buffer: Pointer; bufSize: DWORD;  returnSize: TPDword): DWORD; stdcall = nil;  liOldIdleTime: LARGE_INTEGER = (); liOldSystemTime: LARGE_INTEGER = (); function Li2Double(x: LARGE_INTEGER): Double; begin  Result := x.HighPart * 4.294967296E9 + x.LowPart  end; procedure GetCPUUsage;  var SysBaseInfo: TSystem_Basic_Information;  SysPerfInfo: TSystem_Performance_Information;  SysTimeInfo: TSystem_Time_Information; status: Longint; {long}  dbSystemTime: Double;  dbIdleTime: Double; Inf: integer; bLoopAborted : boolean;  begin  if @NtQuerySystemInformation = nil then  NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQuerySystemInformation');  // get number of processors in the system status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);  if status <> 0 then Exit; { // Show some information with SysBaseInfo do begin ShowMessage( Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+ 'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+ 'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+ 'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d', [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages, uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity, uKeActiveProcessors, bKeNumberProcessors])); end; } bLoopAborted := False; while not bLoopAborted do  begin // get new system time  status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0); if status <> 0 then Exit;  // get new CPU's idle time status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);  if status <> 0 then Exit;  // if it's a first call - skip it  if (liOldIdleTime.QuadPart <> 0) then  begin // CurrentValue = NewValue - OldValue  dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime); dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);  // CurrentCpuIdle = IdleTime / SystemTime dbIdleTime := dbIdleTime / dbSystemTime; // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;  // Show Percentage Inf:= StrToInt(FormatFloat('0',dbIdleTime)); Form1.Gauge1.Progress:=Inf-1; Application.ProcessMessages; // Abort if user pressed ESC or Application is terminated  bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated; end;  // store new CPU's idle and system time  liOldIdleTime := SysPerfInfo.liIdleTime;  liOldSystemTime := SysTimeInfo.liKeSystemTime; // wait one second Sleep(1000); end;  end;  procedure TForm1.Button1Click(Sender: TObject); begin GetCPUUsage ; end; end. Ответ №3 Вобще-то тебе нужно узнать CPU. Вот тебе пример.   program ....; .. .. const ID_BIT = $200000; // EFLAGS ID bit function GetCPUSpeed: Double; const DelayTime = 500; var TimerHi, TimerLo: DWORD; PriorityClass, Priority: Integer; begin try PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); Sleep(10); asm dw 310Fh // rdtsc mov TimerLo, eax mov TimerHi, edx end; Sleep(DelayTime); asm dw 310Fh // rdtsc sub eax, TimerLo sbb edx, TimerHi mov TimerLo, eax mov TimerHi, edx end; SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); Result := TimerLo / (1000.0 * DelayTime); except end; end; procedure TForm1.Button1Click(Sender: TObject); var cpuspeed: string; begin cpuspeed := Format('%f MHz', [GetCPUSpeed]); edit1.text := cpuspeed; end; Вопрос №1 Здравствуйте, X-Program... Хотелосьбы узнать как сделать такую прогу, которая выключает комп по событию, в данном случаем по времени или таймеру?! Помогите! Ответ №1 Используйте функцию ExitWindows(). В качестве первого параметра ей передается она из трех констант: EW_RESTARTWINDOWS  EW_REBOOTSYSTEM  EW_EXITANDEXECAPP  Второй параметр используется для перезагрузки компьютера в режиме эмуляции MS DOS. Пример ExitWindows(EW_RESTARTWINDOWS, 0 );

Как принять файлы, брошенные на мою форму по drag & drop  unit Unit1;  interface  uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls;  type  TForm1 = class(TForm)  Memo1: TMemo;  procedure FormCreate(Sender: TObject);  private  procedure WMDROPFILES(var Message: TWMDROPFILES);  message WM_DROPFILES;  { Private declarations }  public  { Public declarations }  end;  var  Form1: TForm1;  implementation  {$R *.DFM}  uses ShellApi;  procedure TForm1.FormCreate(Sender: TObject);  begin  {Let Windows know we accept dropped files}  DragAcceptFiles(Form1.Handle, True);  end;  procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);  var  NumFiles : longint;  i : longint;  buffer : array[0..255] of char;  begin  {How many files are being dropped}  NumFiles := DragQueryFile(Message.Drop,  -1,  nil,  0);  {Accept the dropped files}  for i := 0 to (NumFiles - 1) do begin  DragQueryFile(Message.Drop,  i,  @buffer,  sizeof(buffer));  Form1.Memo1.Lines.Add(buffer);  end;  end;  end.

Как переслать файл в Мусорную Корзину uses ShellAPI;  procedure SendToRecycleBin(FileName: string);  var  SHF: TSHFileOpStruct;  begin  with SHF do begin  Wnd := Application.Handle;  wFunc := FO_DELETE;  pFrom := PChar(FileName);  fFlags := FOF_SILENT or FOF_ALLOWUNDO;  end;  SHFileOperation(SHF);  end;  procedure TForm1.Button1Click(Sender: TObject);  begin  SendToRecycleBin('c:\DownLoad\Test.gif');  end;

Дизайнер рассылки Андрей Ерёмин  |||  Редактор рассылки Коржов Алексей