|
Вопрос # 1 389/ вопрос открыт / |
|
Здравствуйте, эксперты!
Не подскажите как получить значения настроек соединения (прокси порт, прокси адресс), которые используются в Internet Explorer или другом броузере по умолчанию.
Заранее благодарен.
 |
Вопрос задал: ss (статус: Посетитель)
Вопрос отправлен: 3 марта 2008, 12:50
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: Feniks
Здравствуйте, ss!
Держите в Приложении несколько примеров.
Желаю удачи.
Приложение: Переключить в обычный режим-
-
-
-
- {
- First we create a temporary file and call the
- function FindExecutable to get the associated Application.
- }
-
-
- function GetAppName(Doc: string): string;
- var
- FN, DN, RES: array[0..255] of char;
- begin
- StrPCopy(FN, DOC);
- DN[0] := #0;
- RES[0] := #0;
- FindExecutable(FN, DN, RES);
- Result := StrPas(RES);
- end;
-
- function GetTempFile(const Extension: string): string;
- var
- Buffer: array[0..MAX_PATH] of char;
- aFile: string;
- begin
- GetTempPath(SizeOf(Buffer) - 1, Buffer);
- GetTempFileName(Buffer, 'TMP', 0, Buffer);
- SetString(aFile, Buffer, StrLen(Buffer));
- Result := ChangeFileExt(aFile, Extension);
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- var
- f: System.Text;
- temp: string;
- begin
- // get a unique temporary file name
- // eine eindeutige Temporare Datei bekommen
- temp := GetTempFile('.htm');
- // Create the file
- // Datei erstellen
- AssignFile(f, temp);
- rewrite(f);
- closefile(f);
- // Show the path to the browser
- // Pfad + Programmname zum Browser anzeigen.
- ShowMessage(GetAppName(temp));
- // Finally delete the temporary file
- // Temporaare Datei wieder loschen
- Erase(f);
- end;
-
-
- //Using the Registry:
- //************************************************
-
- uses
- Registry;
-
- procedure TForm1.Button1Click(Sender: TObject);
- var
- Reg: TRegistry;
- KeyName: string;
- ValueStr: string;
- begin
- Reg := TRegistry.Create;
- try
- Reg.RootKey := HKEY_CLASSES_ROOT;
- KeyName := 'htmlfileshellopencommand';
- if Reg.OpenKey(KeyName, False) then
- begin
- ValueStr := Reg.ReadString('');
- Reg.CloseKey;
- ShowMessage(ValueStr);
- end
- else
-
- finally
- Reg.Free;
- end;
- end;
-
-
- //************************************************
- {Copyright (c) by Code Central}
-
- type
- TBrowserInformation = record
- Name: string;
- Path: string;
- Version: string;
- end;
-
- function LongPathName(ShortPathName: string): string;
- var
- PIDL: PItemIDList;
- Desktop: IShellFolder;
- WidePathName: WideString;
- AnsiPathName: AnsiString;
- begin
- Result := ShortPathName;
- if Succeeded(SHGetDesktopFolder(Desktop)) then
- begin
- WidePathName := ShortPathName;
- if Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(WidePathName),
- ULONG(nil^), PIDL, ULONG(nil^))) then
-
- try
- SetLength(AnsiPathName, MAX_PATH);
- SHGetPathFromIDList(PIDL, PChar(AnsiPathName));
- Result := PChar(AnsiPathName);
-
- finally
- CoTaskMemFree(PIDL);
- end;
- end;
- end;
-
- function GetDefaultBrowser: TBrowserInformation;
- var
- tmp: PChar;
- res: LPTSTR;
- Version: Pointer;
- VersionInformation: Pointer;
- VersionInformationSize: Integer;
- Dummy: DWORD;
- begin
- tmp := StrAlloc(255);
- res := StrAlloc(255);
- Version := nil;
- try
- GetTempPath(255, tmp);
- if FileCreate(tmp + 'htmpl.htm') <> -1 then
- begin
- if FindExecutable('htmpl.htm', tmp, res) > 32 then
- begin
- Result.Name := ExtractFileName(res);
- Result.Path := LongPathName(ExtractFilePath(res));
- // Try to determine the Browser Version
- VersionInformationSize := GetFileVersionInfoSize(Res, Dummy);
- if VersionInformationSize > 0 then
- begin
- GetMem(VersionInformation, VersionInformationSize);
- GetFileVersionInfo(Res, 0, VersionInformationSize, VersionInformation);
- VerQueryValue(VersionInformation, ('StringFileInfo040904E4ProductVersion'),
- Pointer(Version), Dummy);
- if Version <> nil then
- Result.Version := PChar(Version);
- FreeMem(VersionInformation);
- end;
- end
- else
- ShowMessage('Cannot determine the executable.');
- SysUtils.DeleteFile(tmp + 'htmpl.htm');
- end
- else
- ShowMessage('Cannot create temporary file.');
- finally
- StrDispose(tmp);
- StrDispose(res);
- end;
- end;
- ==================================
-
- uses
- WinInet;
-
- function GetProxyInformation: string;
- var
- ProxyInfo: PInternetProxyInfo;
- Len: LongWord;
- begin
- Result := '';
- Len := 4096;
- GetMem(ProxyInfo, Len);
- try
- if InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len) then
- if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
- begin
- Result := ProxyInfo^.lpszProxy
- end;
- finally
- FreeMem(ProxyInfo);
- end;
- end;
-
- {**************************************************************************
- * NAME: GetProxyServer
- * DESC: Proxy-Server Einstellungen abfragen
- * PARAMS: protocol => z.B. 'http' oder 'ftp'
- * RESULT: [-]
- * CREATED: 08-04-2004/shmia
- *************************************************************************}
- procedure GetProxyServer(protocol: string; var ProxyServer: string;
- var ProxyPort: Integer);
- var
- i: Integer;
- proxyinfo, ps: string;
- begin
- ProxyServer := '';
- ProxyPort := 0;
-
- proxyinfo := GetProxyInformation;
- if proxyinfo = '' then
- Exit;
-
- protocol := protocol + '=';
-
- i := Pos(protocol, proxyinfo);
- if i > 0 then
- begin
- Delete(proxyinfo, 1, i + Length(protocol));
- i := Pos(';', ProxyServer);
- if i > 0 then
- proxyinfo := Copy(proxyinfo, 1, i - 1);
- end;
-
- i := Pos(':', proxyinfo);
- if i > 0 then
- begin
- ProxyPort := StrToIntDef(Copy(proxyinfo, i + 1, Length(proxyinfo) - i), 0);
- ProxyServer := Copy(proxyinfo, 1, i - 1)
- end
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- var
- ProxyServer: string;
- ProxyPort: Integer;
- begin
- GetProxyServer('http', ProxyServer, ProxyPort);
- Label1.Caption := ProxyServer;
- label2.Caption := IntToStr(ProxyPort);
- end;
 |
Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 3 марта 2008, 13:16
Оценка за ответ: 5
|
Мини-форум вопроса
Мини-форум пуст.
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
