Как проверить подключен ли компьютер к internet ?
interface uses Windows, SysUtils, Registry, WinSock, WinInet;
type TConnectionType = (ctNone, ctProxy, ctDialup);
function ConnectedToInternet : TConnectionType; function RasConnectionCount : Integer;
implementation
//For RasConnectionCount ======================= const cERROR_BUFFER_TOO_SMALL = 603; cRAS_MaxEntryName = 256; cRAS_MaxDeviceName = 128; cRAS_MaxDeviceType = 16; type ERasError = class(Exception);
HRASConn = DWord; PRASConn = ^TRASConn; TRASConn = record dwSize: DWORD; rasConn: HRASConn; szEntryName: Array[0..cRAS_MaxEntryName] Of Char; szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char; szDeviceName : Array [0..cRAS_MaxDeviceName] of char; end;
TRasEnumConnections = function (RASConn: PrasConn; { buffer to receive Connections data } var BufSize: DWord; { size in bytes of buffer } var Connections: DWord { number of Connections written to buffer } ): LongInt; stdcall; //End RasConnectionCount =======================
function ConnectedToInternet: TConnectionType; var Reg : TRegistry; bUseProxy : Boolean; UseProxy : LongWord; begin Result := ctNone; Reg := TRegistry.Create; with REG do try try RootKey := HKEY_CURRENT_USER; if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet settings',False) then begin //I just try to read it, and trap an exception if GetDataType('ProxyEnable') = rdBinary then ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) ) else begin bUseProxy := ReadBool('ProxyEnable'); if bUseProxy then UseProxy := 1 else UseProxy := 0; end; if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy; end; except //Obviously not connected through a proxy end; finally Free; end;
//We can check RasConnectionCount even if dialup networking is not installed //simply because it will return 0 if the DLL is not found. if Result = ctNone then begin if RasConnectionCount > 0 then Result := ctDialup; end; end;
function RasConnectionCount : Integer; var RasDLL : HInst; Conns : Array[1..4] of TRasConn; RasEnums : TRasEnumConnections; BufSize : DWord; NumConns : DWord; RasResult : Longint; begin Result := 0;
//Load the RAS DLL RasDLL := LoadLibrary('rasapi32.dll'); if RasDLL = 0 then exit;
try RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA'); if @RasEnums = nil then raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');
Conns[1].dwSize := Sizeof (Conns[1]); BufSize := SizeOf(Conns);
RasResult := RasEnums(@Conns, BufSize, NumConns);
If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns; finally FreeLibrary(RasDLL); end; end;
Вообщем ситуация: нужно отправить созданное моей программой письмо по е-майлу независимо от юзера т.е. чтобы он не подозревал об отправке. Вот бы это на АПИ с примером!
unit Email; interface uses Windows, SusUtils, Classes;
function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
function IsOnline: Boolean;
implementation uses Mapi;
function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean; var MapiMessage: TMapiMessage; MapiFileDesc: TMapiFileDesc; MapiRecipDesc: TMapiRecipDesc; i: integer; s: string; begin with MapiRecipDesc do begin ulRecerved:= 0; ulRecipClass:= MAPI_TO; lpszName:= PChar(RecipName); lpszAddress:= PChar(RecipAddress); ulEIDSize:= 0; lpEntryID:= nil; end;
with MapiFileDesc do begin ulReserved:= 0; flFlags:= 0; nPosition:= 0; lpszPathName:= PChar(Attachment); lpszFileName:= nil; lpFileType:= nil; end;
with MapiMessage do begin ulReserved := 0; lpszSubject := nil; lpszNoteText := PChar(Subject); lpszMessageType := nil; lpszDateReceived := nil; lpszConversationID := nil; flFlags := 0; lpOriginator := nil; nRecipCount := 1; lpRecips := @MapiRecipDesc; if length(Attachment) > 0 then begin nFileCount:= 1; lpFiles := @MapiFileDesc; end else begin nFileCount:= 0; lpFiles:= nil; end; end;
Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS; end;
function IsOnline: Boolean; var RASConn: TRASConn; dwSize,dwCount: DWORD; begin RASConns.dwSize:= SizeOf(TRASConn); dwSize:= SizeOf(RASConns); Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount); Result:= (Res = 0) and (dwCount > 0); end;
end.
Скажите пожалуйста могу ли я из своей программы закрыть чужое приложение и как? »»» Nech (02.07.00 22:11) Скажите пожалуйста могу ли я из своей программы закрыть чужое приложение и как? Почему нельзя просто написать: SendMessage(FormHandle,WM_CLOSE,0,0);
»»» kingdom - kingdom@tepkom.ru (09.07.00 18:48) Возможно надо не FormHandle, а ApplicationHandle...
»»» Sergei - Sergei@polisma.net (09.07.00 21:24) Ситуация следующая в Win32 все приложения идут в отдельном адресном пространсте, поэтому handle в одном процессе будет иметь совершенно другое значение в другом (если он вообще там будет). Однако способы решения данной проблемы существуют см. например TerminateProcess.
»»» Merlin (10.07.00 03:17) Сергей, а нельзя ли пример? (ели уже сталкивался с этим?)
»»» Sergei - Sergei@polisma.net (10.07.00 18:13) Для хорошего примера наверно нужно более подробно описать интересующую ситуацию. Например вы можете получит идентификаторы о всех процессов в ситеме EnumProcesses(...) Затем можно открыть нужный hendle процесса OpenProcess(...). Далее процесс можно убить TerminateProcess(...). Не забудте также вызвать CloseHandle(...). TerminateProcess(...) имеет свои недостатки, так как при этом не происходит исполнение секций отключения от DLL для завершаемого процесса. Опишите конкретно ситуацию.
»»» alex10 - alex10@atom.ru ето издевательсво - просто findwindow(classname,windowname) если известно имя окна надо пускать repeat h:=getwindow(h,GW_HWNDNEXT); getwindowtext(h,p,sizeof(p); until (p='текст') or (h=0);
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Кто-нибудь может кинуть мне пример программирования COM портов »»» Rukhimovich Oleg - rukhiich@hotmail.com (06.06.00 20:23) Если нужны подробности, пишите.
unit TestRosh;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type TForm1 = class(TForm) Panel1: TPanel; Label1: TLabel; PortCombo: TComboBox; Label2: TLabel; BaudCombo: TComboBox; Label3: TLabel; ByteSizeCombo: TComboBox; Label4: TLabel; ParityCombo: TComboBox; Label5: TLabel; StopBitsCombo: TComboBox; Label6: TLabel; Memo1: TMemo; Edit1: TEdit; Button1: TButton; Memo2: TMemo; Edit2: TEdit; Label7: TLabel; Button2: TButton; Label8: TLabel; Edit3: TEdit; procedure Button1Click(Sender: TObject); procedure Memo2Change(Sender: TObject); procedure Memo1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button2Click(Sender: TObject); procedure PortComboChange(Sender: TObject); procedure FormShow(Sender: TObject); procedure Memo1DblClick(Sender: TObject); end;
var Form1: TForm1;
implementation
{$R *.DFM}
uses Registry;
var hPort: THandle;
procedure TForm1.Memo1Change(Sender: TObject); var i: Integer; begin Edit1.Text := ''; for i := 1 to Length(Memo1.Text) do Edit1.Text := Edit1.Text + Format('%x', [Ord(Memo1.Text[i])]) + ' ' end;
procedure TForm1.Memo2Change(Sender: TObject); var i: Integer; begin Edit2.Text := ''; for i := 1 to Length(Memo2.Text) do Edit2.Text := Edit2.Text + Format('%x', [Ord(Memo2.Text[i])]) + ' ' end;
procedure TForm1.Button1Click(Sender: TObject); var S, D: array[0..127] of Char; actual_bytes: Integer; DCB: TDCB; begin
FillChar(S, 128, #0); FillChar(D, 128, #0);
DCB.DCBlength := SizeOf(DCB);
if not GetCommState(hPort, DCB) then begin ShowMessage('Can''t get port state: ' + IntToStr(GetLastError)); Exit; end;
try DCB.BaudRate := StrToInt(BaudCombo.Text); except BaudCombo.Text := IntToStr(DCB.BaudRate); end;
try DCB.ByteSize := StrToInt(ByteSizeCombo.Text); except ByteSizeCombo.Text := IntToStr(DCB.ByteSize); end;
if ParityCombo.ItemIndex > -1 then DCB.Parity := ParityCombo.ItemIndex else ParityCombo.ItemIndex := DCB.Parity;
if StopBitsCombo.ItemIndex > -1 then DCB.StopBits := StopBitsCombo.ItemIndex else StopBitsCombo.ItemIndex := DCB.StopBits;
if not SetCommState(hPort, DCB) then begin ShowMessage('Can''t set new port settings: ' + IntToStr(GetLastError)); Exit; end;
PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
StrPCopy(S, Memo1.Text);
if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then begin ShowMessage('Can''t write to port: ' + IntToStr(GetLastError)); Exit; end;
if not ReadFile(hPort, D, StrToInt(Edit3.Text), actual_bytes, nil) then ShowMessage('Can''t read from port: ' + IntToStr(GetLastError)) else ShowMessage('Read ' + IntToStr(actual_bytes) + ' bytes'); Memo2.Text := D; end;
procedure TForm1.FormDestroy(Sender: TObject); begin with TRegistry.Create do begin OpenKey('\Software\MBEM\Rosh Shkila', True); WriteString('Port', PortCombo.Text); WriteString('Baud Rate', BaudCombo.Text); WriteString('Byte Size', ByteSizeCombo.Text); WriteString('Parity', IntToStr(ParityCombo.ItemIndex)); WriteString('Stop Bits', IntToStr(StopBitsCombo.ItemIndex)); Destroy; end; if not CloseHandle(hPort) then begin ShowMessage('Can''t close port: ' + IntToStr(GetLastError)); Exit; end; end;
procedure TForm1.Button2Click(Sender: TObject); begin hPort := CreateFile(PChar(PortCombo.Text), GENERIC_READ + GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hPort = INVALID_HANDLE_VALUE then ShowMessage('Can''t open ' + PortCombo.Text + ': ' + IntToStr(GetLastError)) else Button2.Hide; end;
procedure TForm1.PortComboChange(Sender: TObject); begin FormDestroy(Sender); Button2.Show; end;
procedure TForm1.FormShow(Sender: TObject); begin with TRegistry.Create do begin OpenKey('\Software\MBEM\Rosh Shkila', True); PortCombo.Text := ReadString('Port'); BaudCombo.Text := ReadString('Baud Rate'); ByteSizeCombo.Text := ReadString('Byte Size'); ParityCombo.ItemIndex := StrToInt(ReadString('Parity')); StopBitsCombo.ItemIndex := StrToInt(ReadString('Stop Bits')); Destroy; end; end;
procedure TForm1.Memo1DblClick(Sender: TObject); begin Memo1.Lines.Clear; Memo2.Lines.Clear; Edit1.Text := ''; Edit2.Text := ''; end;
end.
»»» peter - ppp_extr@chat.ru (03.07.00 09:05) Пример вывода текста на печать используя ком порт
Var Printer: THandle; N : Cardinal; C : POverlapped;
begin //Открываем порт принтера для записи Printer := CreateFile(PChar('LPT1'), GENERIC_READ or GENERIC_WRITE,0,nil, OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);
//Печатаем слово 'Hello World'; WriteFile(Printer,'Hello World',11,N,c); //Закрываем порт CloseHandle(Printer);
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Подскажите какие ХОРОШИЕ программы есть для создания ИНТАЛЯШЕК »»» kingdom (26.07.00 21:19) День добрый !
1) Поделитесь опытом, расскажите как лучше писать ИНСТАЛЯШКУ, чтобы и в реестр лазела и комп перегружала и все остальное... Есть InstallSheild Express, но это слабовато.
2)Если не сложно расскажите немного об InstallSheild (обычном), что это такое, насколько сложное и гобкое средство.
Спасибо !
»»» balda - stub@inbox.ru (27.07.00 06:50) есть крутая прога как Wise Install Master у меня на компашке 60 метров. ну очень кульная. скрипт свой мона писать...и в реестр. я ей пользуюсь.
»»» DarkTram (30.07.00 20:17) Vise Installer 3.0 (MindVision) - рулезная штука (~3Mb) Нужно крякнуть. Я использую: Name: Kooky [HERiTAGE] Pass: IVR400W7921285
»»» Mark - mark@kangaroonet.com (02.08.00 18:37) Setup Factory !!!
Очень мощный и компактный инсталлятор.
»»» Vlad - v987@mail.ru (03.08.00 12:24) По работе использую InstallSheild Prof.6.02 штука конечно мощная, но для решения общих/типовых задач... А вот как только надо сделать инсталятор разбитый на 2-е фазы (2-ая фаза после перезагрузки).. то тут начинаются приключения.. К тому же версия 6.02 удобнее чем 5.X, но и баг в ней прилично :) "немного об InstallSheild" я вроде рассказал. Подробнее могу ответить только на конкретные вопросы
»»» O$AE - osae@newmail.ru (15.08.00 13:39) Рекомендую Wise Install Master 7.0 и выше. Интерфейс понятен, есть возможность писать на script. Если негде взять пиши.
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Как получить сеpийные номеpа биоса и т.п.?
Вот пример как можно даты БИОС материнской платы и видеокарты выдрать. То же самое можно с названием производителя и версией. В WinNT приходится читать не из ПЗУ а из реестра но это достаточно надежно - соотв ключи WinNT закрывает на запись и обновляет при каждом старте (?). Для Win9x можешь хоть весь БИОС напрямую читать.
Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО невозможно - порты IDE даже Win9x блокирует.
type TRegistryRO = class (TRegistry) function OpenKeyRO (const Key: string): Boolean; end; { это уже ветхая история - был один глюк у D3}
implementation
uses WAPIInfo, Windows, SysUtils, StrUtils;
function TRegistryRO.OpenKeyRO (const Key: string): Boolean; function IsRelative(const Value: string): Boolean; begin Result := not ((Value <> '') and (Value[1] = '\')) end; var TempKey: HKey; S: string; Relative: Boolean; begin S := Key; Relative := IsRelative(S); if not Relative then Delete(S, 1, 1); TempKey := 0; Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0, KEY_READ, TempKey) = ERROR_SUCCESS; if Result then begin if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S; ChangeKey(TempKey, S); end; end;
function GetBIOSDate : string; const BIOSDatePtr = $0ffff5; SystemKey = 'HARDWARE\DESCRIPTION\System'; BiosDateParam = 'SystemBiosDate'; var p : pointer; s : string[128]; begin if OSisNT then begin with TRegistryRO.Create do try RootKey := HKEY_LOCAL_MACHINE; if OpenKeyRO (SystemKey) then begin s := ReadString (BiosDateParam); end; finally Free; end; { of try} end else try s[0] := #8; p := Pointer(BIOSDatePtr); Move (p^, s[1], 8); except FillChar (s[1], 8, '9'); end; { of try} Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2); end;
function GetVideoDate : string; const VideoDatePtr = $0C0000; SystemKey = 'HARDWARE\DESCRIPTION\System'; VideoDateParam = 'VideoBiosDate'; var p : pointer; s : string[255]; begin if OSisNT then begin with TRegistryRO.Create do try RootKey := HKEY_LOCAL_MACHINE; if OpenKeyRO (SystemKey) then s := ReadString (VideoDateParam) else s := 'NT/de/tected'; finally Free; end; { of try} end else try s[0] := #255; p := Pointer(VideoDatePtr + 60); { первые $60 - строка CopyRight} Move (p^, s[1], 255); if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8) else begin p := Pointer(VideoDatePtr + 60 + 250); Move (p^, s[1], 255); if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8); end; except FillChar (s[1], 8, '9'); end; { of try} Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2); end;
unit WAPIInfo;
interface
uses Registry, SysUtils, Windows;
procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string); function OSisNT : boolean; procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string); procedure GetMemInfo (var MemStr : string);
implementation
procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string); var OSVerInfo : TOSVersionInfo; Reg : TRegistry; s : string; begin OSVerInfo.dwOSVersionInfoSize := SizeOf (OSVerInfo); GetVersionEx (OSVerInfo); OSID := OSVerInfo.dwPlatformID; case OSID of VER_PLATFORM_WIN32S : OSStr := 'Windows 3+'; VER_PLATFORM_WIN32_WINDOWS : OSStr := 'Windows 95+'; VER_PLATFORM_WIN32_NT : begin OSStr := 'Windows NT'; Reg := TRegistry.Create; Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey ('SYSTEM\CurrentControlSet\Control\', False) then try s := Reg.ReadString ('ProductOptions') except s := '' end; if s = 'WINNT' then OSStr := OSStr + ' WorkStation' else if s = 'SERVERNT' then OSStr := OSStr + ' Server 3.5 & hi' else if s = 'LANMANNT' then OSStr := OSStr + ' Advanced server 3.1'; Reg.Free; end; end; with OSVerInfo do OSStr := OSStr + Format (' %d.%d (выпуск %d)', [dwMajorVersion, dwMinorVersion, LoWord(dwBuildNumber)]); end;
function OSisNT : boolean; var s : string; i : DWORD; begin GetOSVerInfo (i, s); Result := (i = VER_PLATFORM_WIN32_NT); end;
procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string); var SI : TSystemInfo; begin GetSystemInfo (SI); CPUID := SI.dwProcessorType; case CPUID of 386: CPUStr := '80386-совместимый процессор'; 486: CPUStr := '80486-совместимый процессор'; 586: CPUStr := 'Pentium-совместимый процессор'; else CPUStr := 'Неизвестный процессор'; end; { case SI.wProcessorArchitecture of PROCESSOR_ARCHITECTURE_INTEL: ; MIPS ALPHA PPC UNKNOWN end;} end;
procedure GetMemInfo (var MemStr : string); var MemInfo : TMemoryStatus; begin MemInfo.dwLength := SizeOf (MemInfo); GlobalMemoryStatus (MemInfo); with MemInfo do MemStr := Format ('ОЗУ: %0.2f M (свободно %0.2f M)'#$d+ ' Файл подкачки: %0.2f M (свободно: %0.2f M)'#$d, [(dwTotalPhys div 1024) / 1024, (dwAvailPhys div 1024) / 1024, (dwTotalPageFile div 1024) / 1024, (dwAvailPageFile div 1024) / 1024]); end;
end.
PS Возможно, эти процедуры не всегда дату возвращают ;) но то что практически всегда для разных материнских/видео плат возвращаются разные значения - проверено, что мне собственно и требовалось.
Andrey Sorokin from sunny ;) Saint-Petersburg anso@mail.ru Russian Technology http://attend.to/rt anso@rt.spb.ru
Как вызвать процедуру из чужого ЕХЕ файла »»» Dima (08.07.00 20:35) Проблема такая : на сервере стоит ЕХЕ-файл, написан на FoxPro. И как класс зарегистрирован в системном реестре. Есть описание его процедур ( название, параметры). Существует ли возможность на Delphi обратиться к процедурам и заставить их сработать.
»»» Шевелев Дмитрий - maestro@bashneft.ru (21.07.00 13:07) Видимо речь идет о сервере OLE, написанном на FoxPro (первый раз про такое слышу). Если так, то используй его как обычный OLE-сервер:
Var vMyServer : OLEVariant; Begin vMyServer := CreateOLEObject("имя CLSID"); vMyServer.Имя_метода(...); ... vMyServer := Null; End;
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Можно-ли из Дельфей вызвать Outlook и автоматически послать месаги »»» Юрий (28.06.00 14:29) Здравствуйте, помогите пожалуйста решить проблему (если она решаема) Мне надо выбрать из БД e-mail адреса и разослать по ним месаги с attachmentами (можно ли из Дельфи вызвать Outlook Express и какими-нибудь командами заставить его сгенерить сообщение и послать его???) ну типа как отчеты с помощью Wordа генерить... Заранее большой THANX!
»»» Mike Goblin - mgoblin@mail.ru (29.06.00 15:11) В Delphi 5 есть целая закладка Servers - на ней есть компоненты типа OutlookApplication, MailItem для связи с почтой. Однозначно надо попробовать их расколупать. У MailItem даже есть методы Send, Reply, итд, св-во Attachments. Определенно наводит на мысли.
»»» Юрий - yurka1399@mail.ru (29.06.00 18:23) Спасибо Mike обязательно покопаюсь (ато я сервера эти и не смотрел даже) привык по старинке... руками Еще раз спасибо
»»» 2VS - Vlastin_SV@irkutskgiprodor.ru (27.07.00 06:16) По моему с серверами это трудный путь и к тому же требующий хорошую машину, я бы обратил внимание на ззакладку FastNet компонент NMSMTP в своё время я то же писал програмку для автоматизации рассылки отчёто и без особых затрат справился, но исходники к сожалению не сохранились, потерял при смене места работы. С уважением Сергей
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Как можно подключить dll`ку и как использовать её функции... »»» Slava (24.05.00 13:53) Как можно подключить dll`ку и как использовать её функции, да и ещё можно ли узнать, какие параметры нужно передавать функции в dll`ке???
»»» Mike Goblin - mgoblin@mail.ru (27.05.00 13:35) По-разному 1. Статическое связывание DLL клади или в папку Windows(чтобы путь туда был прописан) или в папку с exe. Процедуры из DLL объяви как procedure DoSomething; external 'MYLIB.DLL'; И вроде как все. 2. Динамическое ну тут API надо юзать:вот кусок из хелпа от дельфи:
uses Windows, ...; type
TTimeRec = record Second: Integer; Minute: Integer; Hour: Integer; end;
TGetTime = procedure(var Time: TTimeRec);
THandle = Integer;
var
Time: TTimeRec; Handle: THandle; GetTime: TGetTime; ... begin Handle := LoadLibrary('DATETIME.DLL'); if Handle <> 0 then begin @GetTime := GetProcAddress(Handle, 'GetTime'); if @GetTime <> nil then begin GetTime(Time); with Time do WriteLn('The time is ', Hour, ':', Minute, ':', Second); end; FreeLibrary(Handle); end;
end;
»»» 2VS (27.07.00 06:30) Могу добавить, что в стандарном наборе Дельфы всех версий есть консольная програмка ...\delphi\bin\TDUMP.EXE для исследования библиотек с помощью которой мона просмотреть всю информацию по библиотеке штука хорошая только вот вываливает информации вагон без описания трудновато понять что куда если интересно то могу выслать некоторую информацию по этой проге.
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
dialup и delphi »»» Григорий (02.08.00 17:48) Как установить соединение с интернетом средствами делфи
»»» Dmitry - dimitris@talkie.co.il (16.08.00 11:19) Try TRasControl from http://www.torry.ru/vcl/comms/ras
»»» kig - kig@slc.ru (16.08.00 11:33) Посмотрите в описании winint api след. ф-ции (в Д - unit WinInit)
Function Description InternetAutodial - Initiates an unattended dial-up connection. InternetAutodialHangup - Disconnects a modem connection initiated by InternetAutodial. InternetDial - Initiates a dial-up connection. InternetGetConnectedState - Retrieves the current state of the Internet connection. InternetHangUp - Disconnects a modem connect initiated by InternetDial. InternetGoOnline - Prompts the user for permission to initiate a dial-up connection to the given URL. InternetSetDialState - Sets the current state of the Internet connection
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Доступ к памяти чужой программы »»» Vasiliy (26.05.00 15:31) Подскажите пожалуйста как можно определить какой участок памяти занимает запущеная ранее программа и ее данные, и получить доступ к памяти чужой программы(процесса).
»»» Sergei - Sergei@polisma.net (10.07.00 17:43) О это очень интересная проблема. Для ее решения под win32 необходимо внедрять dll в чужой процес. Ваш вопрос очень хорошо описан в книге Джеффри Рихтер windos для профессионалов (последняя глава)
»»» Romych (11.07.00 15:02) А если нужно просто иметь общую область памяти для обмена данными между двумя программами, можно использовать Memory mapped files.
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
TWebBrowser »»» Nuke Dukem (20.07.00 12:53) Может подскажете, как заставить NWebBrowser (или что-то другое) работать не с файлом или УРЛ, а с создаваемыми программой html-ками. Т.е. прога создала некое 'Test' и это надо подсунуть TWebBrowser-у безо всяких файлов и УРЛ-ов. Заранее спасибо за ответ.
»»» Merlin (20.07.00 14:30) Сначала разберись, что ты подразумеваешь под словом "Т.е. прога создала некое..." ГДЕ создала? Если у себя в памяти, то подсунуть это ьраузеру ОЧЕНЬ сложно, проще браузер всунуть в программу :) Или сохрани все что создал в WindowsTemp директорию и попроси браузер открыть это...
»»» kig - kig@slc.ru (21.07.00 19:49) TWebBrowser.Document.write[ln](string)
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Как зарегистрировать свое расшерения для файлов? Т.е. чтобы при щелчке по такому файлу вызывалась моя программа. Вот пример:
//Use the registry to register your own filetype.
uses registry;
procedure TForm1.RegisterFileType(prefix:String; exepfad:String); var reg:TRegistry; begin reg:=TRegistry.Create; reg.RootKey:=HKEY_CLASSES_ROOT; //create a new key --> .pci reg.OpenKey('.'+prefix,True); //create a new value for this key --> pcifile reg.WriteString('',prefix+'file'); reg.CloseKey; //create a new key --> pcifile reg.CreateKey(prefix+'file'); //create a new key pcifile\DefaultIcon reg.OpenKey(prefix+'file\DefaultIcon',True); //and create a value where the icon is stored --> c:\project1.exe,0 reg.WriteString('',exepfad+',0'); reg.CloseKey; reg.OpenKey(prefix+'file\shell\open\command',True); //create value where exefile is stored --> c:\project1.exe "%1" reg.WriteString('',exepfad+' "%1"'); reg.CloseKey; reg.Free; end;
procedure TForm1.Button1Click(Sender: TObject); begin RegisterFileType('pci','c:\project1.exe'); end;
Принтер в Delphi »»» Andrey (08.06.00 20:22) Уважаемые прошу вас подсказать как с помощью WriteLn-на послать управляющие коды на принтер, и возможно ли такое. Заранее благодарен Андрей.
»»» sky3d - sky3d@mail.ru (11.08.00 15:36) Недавно узнал о конференции, пишу первый раз, надеюсь не в последний. При печати Dos-файла в порт напрямую можно это сделать.
Например, напечатать за 2 прохода: ESC @ - инициализация принтера ESC G - включение режима печати за 2 прохода ESC H - выключение режима печати за 2 прохода
Var FileOut : TextFile; filename : String [128]; .... Filename:='PRN'; AssignFile(Fileout,Filename); ... Write(FileOut,Chr(27)+'@'); Str1:=AnToAs(chr(27)+'G'+'Double'+chr(27)+'H'); Writeln(FileOut,Str1); ...
{преобразование Ansi to Ascii} function AnToAs(s: String) : String; Var i,kod : Integer; begin Result:=s; for i:=1 to length(s) do begin kod:=Ord(s[i]); if kod < 13 then Result[i]:=' '; if ( kod>=192) and ( kod<=239) then Result[i]:=Chr(kod-64); if ( kod>=240) and ( kod<=255) then Result[i]:=Chr(kod-16); if kod=168 then Result[i]:=Chr(240); if kod=184 then Result[i]:=Chr(241); end; end;
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Как програмно перезагрузить Windows? Используйте функцию ExitWindows(). В качестве первого параметра ей передается она из трех констант: EW_RESTARTWINDOWS EW_REBOOTSYSTEM EW_EXITANDEXECAPP
Второй параметр используется для перезагрузки компьютера в режиме эмуляции MS DOS. Пример:
ExitWindows(EW_RESTARTWINDOWS, 0 );
Источник: Дельфи. Вокруг да около.
TTimer работает не достаточно точно. Как получить более высокую точность? Таймер Windows не был создан с целью получения сверхточного хронометра. :-( Другими словами, когда Вы устанавливаете таймер на срабатывания каждые 1000 миллисекунд, он может срабатывать через интервал несколько больший чем 1000 миллисекунд. Значения меньше 55 миллисекунд никогда не будут срабатывать вовремя в Windows, поскольку это минимальная точность таймера. Можно проверять системное время и сравнивать его со временем предыдущего события таймера чтобы повысить точность.
Как получить имена свободных com портов?
//Show the names of available comm ports (com1, com2, ...)
//Used registry key: hkey_local_machine\hardware\devicemap\serialcomm
uses registry;
...
procedure TForm1.Button1Click(Sender: TObject); var reg : TRegistry; st : TStrings; i : integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('hardware\devicemap\serialcomm',false); st := TStringList.Create; reg.GetValueNames(st); for i := 0 to st.Count -1 do begin Memo1.Lines.Add(reg.ReadString(st.Strings[i])); end; st.Free; reg.CloseKey; reg.free; end;
Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно? GetAsyncKeyState. И для клавиатуpы, и для мыши. Источник: Дельфи. Вокруг да около.
Курсор мыши за границами активной формы. »»» fred (19.05.00 02:30) 1) Форма активна и открыта функцией ShowModal. Необходимо выполнить некоторые действия когда курсор мыши находится за границами формы и нажимается кнопка мыши. Существует ли возможность отловить это событие. (Было предложение с борландовкого сайта использовать свойство TControl.MouseCapture. Я пробовал - ничего не получилось) 2) Подскажите адрес аналогичной конференции по CBuilder.
»»» 2VS - Vlastin_SV@irkutskgiprodor.ru (27.07.00 06:05) Мне кажеться что такое в принципе противоречит системе Windows потому как когда в приложении открываеться модальная форма, то очередь собщений приложения заменяеться очередью сообщений открытого модального окна и получается, что система обрабатывает только одно окно приложения.
»»» maestro - maestro@bashneft.ru (27.07.00 13:41) Кажется где-то читал, что до того как сообщение попадет в очередь контрола, оно попадает в системную очередь Windows. Вот если вклинить свой обработчик в эту очередь, то в принципе можно отловить любое сообщение для любого работающего приложения. Попробуй поэксперементировать с GetWindowLong и SetWindowLong. Кстати в RXLib есть компонент, RxWindowHooker кажется, там можно посмотреть как этот метод применяется на практике. А метод с MouseCapture должен работать
»»» Hordi - iqsoft@news.cg.ukrtel.net (28.07.00 01:24) В принципе, можно организовать новый поток и перед выводом модального окна его вызвать. Это позволяет проводить любую фоновую работу, в том числе и отслеживать позицию курсора.
-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
Как послать message всем? SA> Hадо послать мессагy всем заинтеpесованным объектам - pазличным SA> классам - фоpмам, контpолам и т.д.? Пpобовал делать так: SA> const SA> FM_FINDPHOTO = $0510; SA> SendMessage(HWND_BROADCAST,FM_FINDPHOTO,0,0); SA> Hи чеpта не ловится, пока напpямyю хэндл не yкажешь :(
Для использовать hwnd_Broadcast нужно сперва зарегистрировать уникальное сообщение FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll');
Чтобы поймать это сообщение в другом приложении нужно перекрыть DefaultHandler
procedure TForm1.DefaultHandler(var Message); begin with TMessage(Message) do begin if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM) else Inherited DefaultHandler(Message); end; end;
Для посылки сообщения дочерним контролам можно использовать процедуру Broadcast.
Работа с принтером. Delphi имеет стандартный объект для доступа к принтеру - TPRINTER, находящийся в модуле PRINTERS. В этом модуле имеется переменная Printer:Tpinter, что избавляет от необходимости описывать свою. Он позволяет выводить данные на печать и управлять процессом печати. Правда, в некоторых версиях Delphi 1 он имеет "глюк" - не работают функции Draw и StrethDraw. Но эта проблема поправима - можно использовать функции API. Далее приведены основные поля и методы объекта Printers : PROPERTY Aborted:boolean - Показывает, что процесс печати прерван Canvas:Tcanvas - Стандартный Canvas, как у любого графического объекта. Он позволяет рисовать на листе бумаге графику, выводить текст ... . Тут есть несколько особенностей, они описаны после описания объекта. Fonts:Tstrings - Возвращает список шрифтов, поддерживаемых принтером Handle:HDS - Получить Handle на принтер для использования функций API (см. Далее) Orientation:TprinterOrientation - Ориентация листа при печати : (poPortrait, poLandscape) PageHeight:integer - Высота листа в пикселах PageNumber:integer - Номер страницы, увеличивается на 1 при каждом NewPage PageWidth:integer - Ширина листа в пикселах PrinterIndex:integer - Номер используемого принтера по списку доступных принтеров Printers Printers:Tstrings - Список доступных принтеров Printing:boolean - Флаг, показывающий, что сейчас идет процесс печати Title:string - Имя документа или приложения. Под этим именем задание на печать регистрируется в диспетчере печати
METODS AssignPrn(f:TextFile) - Связать текстовый файл с принтером. Далее вывод информации в этот файл приводит к ее печати. Удобно в простейших случаях. Abort - Сбросить печать BeginDoc - Начать печать NewPage - Начать новую страницу EndDoc - Завершить печать.
Пример :
Procedure TForm1.Button1Click(Sender: TObject); Begin With Printer do Begin BeginDoc; { Начало печати } Canvas.Font:=label1.font; { Задали шрифт } Canvas.TextOut(100,100,'Это тест принтера !!!'); { Печатаем текст } EndDoc; { Конец печати } end; end;
Особенности работы с TPrinter
1. После команды BeginDoc шрифт у Canvas принтера сбрасывается и его необходимо задавать заново 2. Все координаты даны в пикселах, а для нормальной работы необходимы миллиметры (по двум очевидным причинам: очень трудно произвести разметку страницы в пикселах (особенно если необходима точность), и , главное, при изменении разрешающей способности принтера будет изменяться число точек на дюйм, и все координаты "поедут". 3. У TPrinter информация о принтере, по видимому, определяются один раз - в момент запуска программы (или смены принтера). Поэтому изменение настроек принтера в процессе работы программы может привести к некорректной работе, например, неправильной печать шрифтов True Type. Определение параметров принтера через API Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle. Далее вызывается функция API (unit WinProcs) : GetDevice(Handle:HDC; Index:integer):integer; Index - код параметра, который необходимо вернуть. Для Index существует ряд констант : DriverVersion - вернуть версию драйвера Texnology - Технология вывода, их много, основные dt_Plotter - плоттер dt_RasPrinter - растровый принтер dt_Display - дисплей HorzSize - Горизонтальный размер листа (в мм) VertSize - Вертикальный размер листа (в мм) HorzRes - Горизонтальный размер листа (в пикселах) VertRes - Вертикальный размер листа (в пикселах) LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм) LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм) Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все. Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера. Пример таких функций:
Procedure TForm1.GetPrinterInfo; { Получить информацию о принтере } begin PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX); PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY); end;
Function TForm1.PrinterCoordX(x:integer):integer; { переводит координаты из мм в пиксели } begin PrinterCoordX:=round(PixelsX/25.4*x); end;
Function TForm1.PrinterCoordY(Y:integer):integer; { переводит координаты из мм в пиксели } begin PrinterCoordY:=round(PixelsY/25.4*Y); end; --------------------------------- GetPrinterInfo; Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55), 'Этот текст печатается с отступом 30 мм от левого края и '+ '55 мм от верха при любом разрешении принтера');
Данную методику можно с успехом применять для печати картинок - зная размер картинки можно пересчитать ее размеры в пикселах для текущего разрешения принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере (180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi) - микроскопической.
Как стереть ехе-файл во время его исполнения? Это невозможно. Вы можете стереть его во время следующего запуска Windows, добавив ключ RunOnce: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce
Пример:
uses Registry;
procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry;
begin reg := TRegistry.Create;
with reg do begin RootKey := HKEY_LOCAL_MACHINE; LazyWrite := false; OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', false); WriteString('Delete Me!','command.com /c del FILENAME.EXT'); CloseKey; free; end; end;
Источник: Дельфи. Вокруг да около.
Как получить дескриптор окна другого приложения и сделать его активным? Использование фуекции Windows API FindWindow() - простейший способ нахождение окна, при условии, что известен его заголовок или имя оконного класса. Если Вам известна только часть заголовка окна (например 'Netscape - ' + 'какой-то неизвестный URL'), Ва м нужно использовать функцию EnumWindows() для получения всех окон, затем вызывать функцию GetWindowsText() и GetClassName для поиска нужного окна. Следующий пример находит первое окно, содержащее совпадающую часть заголовка окна и полностью совпадающее название оконного класса (если он задан) и делает это окно активным.
type PFindWindowStruct = ^TFindWindowStruct; TFindWindowStruct = record Caption : string; ClassName : string; WindowHandle : THandle; end;
function EnumWindowsProc(hWindow : hWnd; lParam : LongInt) : Bool {$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF} var lpBuffer : PChar; WindowCaptionFound : bool; ClassNameFound : bool;
begin GetMem(lpBuffer, 255); Result := True; WindowCaptionFound := False; ClassNameFound := False;
try if GetWindowText(hWindow, lpBuffer, 255) > 0 then if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0 then WindowCaptionFound := true;
if PFindWindowStruct(lParam).ClassName = '' then ClassNameFound := True else if GetClassName(hWindow, lpBuffer, 255) > 0 then if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer)) > 0 then ClassNameFound := True;
if (WindowCaptionFound and ClassNameFound) then begin PFindWindowStruct(lParam).WindowHandle := hWindow; Result := False; end;
finally FreeMem(lpBuffer, sizeof(lpBuffer^)); end; end;
function FindAWindow(Caption : string; ClassName : string) : THandle; var WindowInfo : TFindWindowStruct;
begin with WindowInfo do begin Caption := Caption; ClassName := ClassName; WindowHandle := 0; EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo)); FindAWindow := WindowHandle; end; end;
procedure TForm1.Button1Click(Sender: TObject); var TheWindowHandle : THandle; begin TheWindowHandle := FindAWindow('Netscape - ', ''); if TheWindowHandle = 0 then ShowMessage('Window Not Found!') else BringWindowToTop(TheWindowHandle); end;
Источник: Дельфи. Вокруг да около.
В своей программе я запускаю с помощью CreateProcess приложение (например Notepad), мне необходимо передать Message в окно этого приложения. См. WinAPI - PostThreadMessage.
Как скопировать директорию Использовать ShFileOperation
procedure TForm1.Button2Click(Sender: TObject); var OpStruc: TSHFileOpStruct; frombuf, tobuf: Array [0..128] of Char; begin FillChar( frombuf, Sizeof(frombuf), 0 ); FillChar( tobuf, Sizeof(tobuf), 0 ); StrPCopy( frombuf, 'd:\brief\*.*' ); StrPCopy( tobuf, 'd:\temp\brief' ); with OpStruc do begin Wnd := Handle; wFunc := FO_COPY; pFrom := @frombuf; pTo := @tobuf; fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION; fAnyOperationsAborted := False; hNameMappings := Nil; lpszProgressTitle := Nil; end; ShFileOperation( OpStruc ); end;
|