网站控制问题.(200分)

小弟想把一些网站加入数据库,然后控制这些网站在IE里面和腾迅TT里面都不能打开,
请各位兄台多多指教,小弟唯有的200分全部相送.

不明白，说清楚点。

　　　我再说一下吧，我现在把：“www.baidu.com"加入SiteControl表中，我现在打开IE或者腾迅TT,在地址栏中输入"WWW.baidu.com"回车或刷新后，给出提示"禁止进入"，不准进入”www.baidu.com"这个网站并关闭IE或TT。现在应该够明白了吧。

你不如在防火墙上设置。软件控制，别人不用你的软件怎么办？

防火墙，或路由器

话题2627887的标题是： 写一个限制上网的程序。 (200分)
分类：Internet/TCPIP xuming (2004-05-26 8:53:00)
1：能随IE、腾讯IE、或MYIE启动。或其它启动方式。
2：启动后不能在任务管理器栏内看到。
3：当用户浏览一网站前，查看此网站是否是在禁止的IP列表之内，
如果是属于限制IP列表的就禁止通信。
4：用户可以输入解禁密码可以解禁。

sing_cee (2004-05-26 10:06:52)
给多少钱？

aimeoo (2004-05-26 10:23:00)
楼主的这个想法在我看来非常的实用,我也有这方面的想法.在研究中...

amli (2004-05-26 13:25:04)
你出多少費用,不過我不接受低於RMB3000

hygsxy (2004-05-26 14:11:34)
谈钱的人都可以拉门出去了。呵呵。。。。

xuming (2004-05-26 14:31:07)
不是吧？我是一个低档次程序员呀
3000块？我哪里有呀？
55555

盛利 (2004-05-26 14:47:19)
amli:晕，这也要钱，想揽活挣钱去项目交易网，有的是
这里是技术交流的，你也从这里解决了不少东西了，有人向你要钱了吗？？

xuming:你这个通过ie的bho技术可以实现，而且腾讯IE、或MYIE也是ie核心，所以应该没有问题。http://www.euromind.com/iedelphi/这个网站有很多ie的资料，也有bho的资料
我可以给你个例子程序，你修改修改就可以了。
cunion-sxq#163.com

dgsj (2004-05-26 14:51:46)
我也要，研究研究
k_q_92@yahoo.com.cn

xuming (2004-05-26 15:13:51)
盛利,你好，我的邮箱是dgxum@163.net，麻烦你发个例子给我。谢谢了

xuming (2004-05-26 16:41:17)
查了好多资料，好像比较好的做法类似防火墙的原理，大家有没有什么意见？

parable (2004-05-27 17:06:41)
问题是别人把你的程序卸载、删除或者修改注册表，了不就可以无限制上网了,呵呵.

况且每台机器都安装软件也很麻烦!

这种东西不应该在客户端考虑,应该考虑在服务器端的代理上面实现!

satanmonkey (2004-05-27 19:33:05)
BHO肯定不行，BHO只随 IE启动，并且可以设置成不加载。TE这类的根本就不加载。
你需要用写外挂的技术HOOK scoket api ,然后分析Http协议和IP，不符合的丢包就可以了。

sofox (2004-05-28 16:29:30)
同意parable的观点，如果你一定要在客户端实现，考虑一下自己编写一个Async Pluggable Protocol Handler，替换掉系统自带的Http Protocol Handler。

vctuu (2004-05-29 10:30:54)
盛利,你好，我的邮箱是zfdong1@163.com，麻烦你发个例子给我好吗？谢谢！

app2001 (2004-05-29 10:46:48)
wingate或SYGATE不就是干这活的吗？？？？

zhuxi168 (2004-05-29 11:18:06)
项目交易网在哪？


xuming (2004-05-29 11:33:08)
非常感谢大家踊跃讨论。
下面是要明确几点：
1：程序必需要装在客户端使用。因为所有客户端均是直接连上INTERNET，没有网关限制。
2：功能就是类似于[美萍反黄专家]，但尽最大可能防止用户删除程序。
3：这个软件的目标客户是有孩子的家长。孩子要上网，家长也要上网。孩子不允许看黄色网站。而家长可以没有限制。
4：INTERNET上有一固定服务发布最新的黄色网站列表。客户端每隔7天与服务器同步一次，但面对10W个以上的客户，数据更新应该采用哪种方式呢？
暂时想到这么多。欢迎大家继续扔砖头。

aimeoo (2004-05-29 11:37:14)
我又来了，，继续支持楼主

wchal (2004-05-29 11:51:12)
盛利,給我一份吧!
wchal@163.com
先謝謝了!

刀剑如梦 (2004-05-30 0:27:23)
限制站点方面我来帖一些代码吧.以前整理过的一个小程序.未完成.....
private
OldHomepage: string;
procedure ReadIni(Sender: TObject); //从Ini文件中读取数据
procedure WriteIni(Sender: TObject);//向INI文件中写入数据
procedure MouseMessage(var Message: TMessage); Message MouseMsg;//自定义消息处理函数，处理鼠标点击图标事件
procedure NtidaInstall;
procedure NtidaUnInstall;
procedure AppMinimize(Sender: TObject);
procedure ShowMainWindow;
public
Must:Word;
TagInfo : Boolean;
procedure SetPassword;
end;

var
MeshworkFairyForm: TMeshworkFairyForm;
ntida: TNotifyIcondataA;//用于增加和删除系统状态图标

implementation

uses UnitPassword;

{$R *.dfm}

function RegisterServiceProcess(dwprocessID,dwType:Integer):Integer;
stdcall;external 'KERNEL32.DLL';


procedure TMeshworkFairyForm.AppMinimize(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TMeshworkFairyForm.ShowMainWindow;
begin
Application.Restore;
Application.BringToFront;
end;

procedure TMeshworkFairyForm.MouseMessage(var Message: TMessage);
var
Mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
getcursorpos(Mousept); //获取光标位置
PopupMenu_Task.popup(Mousept.X, Mousept.Y);//在光标位置弹出选单
end;
if message.LParam = wm_lbuttonup then begin //用鼠标左键点击图标
PopupMenu_Task.FreeOnRelease;//释放PopupMenu_Task所占用的资源
Show;
end;
message.Result := 0;
end;


function Filter(URLChar):Boolean;
var
I: Integer;
S: String;
begin
Result:=False;
S:=LowerCase(StrPas(URL));
with MeshworkFairyForm.URLListBox do
for I:=0 to Items.Count-1 do
if pos(Items,S)>0 then
begin
Result:=True;
Exit;
end;
end;

function EnumChildProc(hwnd:HWND;IParam:LPARAM):Bool;stdcall;
var
Buf: array[0..250] of char;
RSize: Integer;
begin
Result:=true;
GetClassName(hwnd,Buf,SizeOf(Buf));
if StrPas(Buf)='Edit' then
begin
RSize:=SendMessage(hwnd,WM_GETTEXT,SizeOf(Buf),Integer(@Buf));
if RSize>0 then
if StrPas(Buf)<>MeshworkFairyForm.NewURLEdit.Text then
if Filter(Buf) then
begin
SendMessage(hwnd,WM_SETTEXT,0,Integer(MeshworkFairyForm.NewURLEdit.Text));
PostMessage(hwnd,WM_KEYDOWN,$D,$1c0001);
PostMessage(hwnd,WM_KEYUP,$D,$c01c0001);
end;
Result:=false;
end;
end;

procedure TMeshworkFairyForm.NtidaInstall;
begin
try
Ntida.cbSize := SizeOf(TNotifyicondataa); //指定ntida的长度
Ntida.Wnd := Handle; //取应用程序主窗体的句柄
Ntida.uID := Number; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使
Ntida.uFlags := nif_icon+nif_tip+nif_message; //指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := MouseMsg;//指定的窗口消息
Ntida.hIcon := Application.Icon.handle;//指定系统状态栏显示应用程序的图标句柄
Ntida.szTip := '网络精灵1.1';//当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @Ntida);//在系统状态栏增加一个新图标
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//隐藏应用程序窗口在任务栏上的显示
except
MessageBox(Handle,'程序即将退出!','错误',MB_OK+MB_ICONSTOP);
Application.Terminate;
end;
end;

procedure TMeshworkFairyForm.NtidaUnInstall;
begin
//为ntida赋值，指定各项参数
Ntida.cbSize := SizeOf(TNotifyicondataa);
Ntida.Wnd := Handle;
Ntida.uID := Number;
Ntida.uFlags := nif_icon + nif_tip + nif_message;
Ntida.uCallbackMessage := MouseMsg;
Ntida.hIcon := Application.Icon.Handle;
Ntida.szTip := '网络精灵1.1';
Shell_notifyicona(NIM_DELETE, @Ntida);//删除已有的应用程序图标
Application.Terminate;//中断应用程序运行，退出应用程序
end;

procedure TMeshworkFairyForm.Timer1Timer(Sender: TObject);
var
fwnd:THandle;
Buf,Buf2: array[0..250] of char;
begin
fwnd:=GetForegroundWindow;
GetClassName(fwnd,Buf,SizeOf(Buf));
GetWindowText(fwnd,Buf2,SizeOf(Buf2));
if (StrPas(Buf)='CabinetWClass') or (StrPas(Buf)='IEFrame') or (Pos('Netscape',StrPas(Buf2))>0) or (Pos('Opera',StrPas(Buf2))>0) or (Pos('Tencent',StrPas(buf2))>0) or (Pos('浏览',StrPas(Buf2))>0) then
EnumChildWindows(fwnd,@EnumChildProc,0);
end;

procedure TMeshworkFairyForm.ReadIni(Sender: TObject);
const
IniFileName='Meshwork.ini'; //Ini文件名=WinPath+'Meshwork.ini'
var
IniFile:TIniFile;
begin
IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
//IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读NotePad.ini
with IniFile do
begin
AutoRunCheckBox.Checked:=ReadBool('SystemSet','AutoRun',True);
NetLimitCheckBox.Checked:=ReadBool('NetLimit','NetControl',True);
ScreenControlCheckBox.Checked:=ReadBool('SystemSet','ScreenControl',True);
end;
end;

procedure TMeshworkFairyForm.WriteIni(Sender: TObject);
const
IniFileName='Meshwork.ini'; //Ini文件名=WinPath+'Meshwork.ini'
var
IniFile:TIniFile;
begin
IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
//IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读NotePad.ini
with IniFile do
begin
WriteBool('SystemSet','AutoRun',AutoRunCheckBox.Checked);
WriteBool('NetLimit','NetControl',AutoRunCheckBox.Checked);
WriteBool('SystemSet','ScreenControl',ScreenControlCheckBox.Checked);
end;
end;

procedure TMeshworkFairyForm.SetPassword;
var
Reg:TRegistry;
begin
if TagInfo then
begin
Reg:=TRegistry.create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software',true);
Reg.WriteString('网络精灵','1111');
finally
Reg.CloseKey;
Reg.Free;
end;
end;
end;

procedure TMeshworkFairyForm.FormCreate(Sender: TObject);
var
Reg:TRegistry;
begin
TagInfo := True;
WindowState:=wsMinimized;
Application.OnMinimize := AppMinimize;
NtidaInstall;
//初始化窗体时添加网址和关键字到列表框中
URLListBox.Items.LoadFromFile('FilterKeys.txt');
SetPassword;
Reg:=TRegistry.create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
OldHomepage:=Reg.ReadString('Start Page');
finally
Reg.CloseKey;
end;
ReadIni(Sender);
NewURLEdit.Text:=ExtractFilePath(Application.ExeName)+'Warnning.htm';
if GlobalFindAtom('MeshworkFairy')=0 then
Must:=GlobalAddAtom('MeshworkFairy') //假如没有找到该文件则添加到系统数据库中
else
begin
MessageBox(Handle,'该程序正在运行!','警告',MB_OK+MB_ICONWARNING); //如果程序已经运行，显示退出信息
Halt;
end;
end;

procedure TMeshworkFairyForm.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(Must);//退出程序时，从数据表中删除添加的文件名
end;

procedure TMeshworkFairyForm.ViewSpeedBtnClick(Sender: TObject);
var
URLEdit: String;
begin
URLEdit:= Trim(URLViewComboBox.Text);
Shellexecute(Handle,'open',PChar(URLEdit),nil,nil,SW_ShowNormal);
end;

procedure TMeshworkFairyForm.SpeedButton1Click(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
Reg.WriteString('Window Title',IETitleEdit.Text);
Reg.WriteString('Start Page',IEHomepageComboBox.Text);
finally
Reg.CloseKey;
end;
end;

procedure TMeshworkFairyForm.SpeedButton2Click(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
Reg.DeleteValue('Window Title');
Reg.WriteString('Start Page',OldHomepage);
finally
Reg.CloseKey;
end;
end;


procedure TMeshworkFairyForm.AutoRunCheckBoxClick(Sender: TObject);
var RegF : TRegistry;
begin
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
//设置开机是否自动运行
if AutoRunCheckBox.Checked then
begin
RegF.DeleteValue('MeshworkFairy');
RegF.WriteString('MeshworkFairy',Application.ExeName);
end
else
RegF.DeleteValue('MeshworkFairy');
except
with Application do
MessageBox('程序内部错误',PChar(Title),MB_OK+MB_ICONERROR);
end;
RegF.CloseKey;
RegF.Free;
end;


procedure TMeshworkFairyForm.NetLimitCheckBoxClick(Sender: TObject);
begin
if NetLimitCheckBox.Checked then
begin
NetLimitCheckBox.Caption:= '取消网络限制功能';
Timer1.Enabled:=True;
end
else
begin
NetLimitCheckBox.Caption:= '启用网络限制功能';
Timer1.Enabled:=False;
end;
end;

procedure TMeshworkFairyForm.IE1Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=0;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.N2Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=1;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.N4Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=2;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.N6Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=3;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.N8Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=4;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.N11Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=5;
ShowMainWindow;
end;
end;

procedure TMeshworkFairyForm.AddURLSpeedBtnClick(Sender: TObject);
var
URLAddress: String;
I: Integer;
begin
URlAddress := Trim(URLAddressEdit.Text);
if URlAddress = '' then
begin
ShowMessage('网址、关键字不能为空');
URLAddressEdit.SetFocus;
end
else
begin
with URLListBox do
begin
for I:=0 to Items.count -1 do
if Items=LowerCase(URLAddress) then
begin
ShowMessage('此关键字已经存在!');
Exit;
end;
URLListBox.Items.Add(LowerCase(URLAddress));
URLListBox.SetFocus;
end;
end;
end;

procedure TMeshworkFairyForm.ExitMeshworkClick(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
WriteIni(Sender);
Shell_Notifyicona(NIM_DELETE, @Ntida);
NtidaUnInstall;
Free;
end;
end;

刀剑如梦 (2004-05-30 0:27:37)
procedure TMeshworkFairyForm.ScreenControlCheckBoxClick(Sender: TObject);
var
Temp: Integer;
begin
Temp := 0;
if ScreenControlCheckBox.Checked then
begin
//屏蔽 Alt-Tab
SystemParametersInfo(SPI_SETFASTTASKSWITCH,1,@temp,0);
//屏蔽 Ctrl-Alt-Del
SystemParametersInfo( SPI_SCREENSAVERRUNNING,1,@temp,0);
ScreenControlCheckBox.Caption := '恢复功能组合键ALT+TAB、CTRL+ALT+DEL';
ScreenControlCheckBox.Hint := '恢复功能组合键ALT+TAB、CTRL+ALT+DEL';
end
else
begin
//恢复 Alt-Tab
SystemParametersInfo(SPI_SETFASTTASKSWITCH,0,@temp,0);
//恢复 Ctrl-Alt-Del
SystemParametersInfo( SPI_SCREENSAVERRUNNING,0,@temp,0);
ScreenControlCheckBox.Caption := '屏蔽功能组合键ALT+TAB、CTRL+ALT+DEL';
ScreenControlCheckBox.Hint := '屏蔽功能组合键ALT+TAB、CTRL+ALT+DEL';
end;
end;
procedure TMeshworkFairyForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := False;
Application.Minimize;
Application.OnMinimize := AppMinimize;
end;

procedure TMeshworkFairyForm.URLAddressEditClick(Sender: TObject);
begin
if URLAddressEdit.Focused then
URLAddressEdit.Text:='';
end;

procedure TMeshworkFairyForm.ClearURLSpeedBtnClick(Sender: TObject);
begin
URLListBox.Clear;
end;

procedure TMeshworkFairyForm.DelURLSpeedBtnClick(Sender: TObject);
var
I: Integer;
begin
I:=0;
while I<=URLListBox.Items.Count-1 do
if URLListBox.Selected then
URLListBox.Items.Delete(i)
else
Inc(I);
URLListBox.SetFocus;
end;

procedure TMeshworkFairyForm.ExportURLSpeedBtnClick(Sender: TObject);
begin
if URLSaveDlg.Execute then
URLListBox.Items.SaveToFile(URLSaveDlg.FileName);
end;

procedure TMeshworkFairyForm.SetWarnSpeedBtnClick(Sender: TObject);
begin
if PubOpenDlg.Execute then
NewURLEdit.Text := PubOpenDlg.FileName;
end;

procedure TMeshworkFairyForm.ImportURLSpeedBtnClick(Sender: TObject);
var
Num: Integer;
MyFile: TextFile;
FN,S: string;
Lines:TStrings;
begin
if PubOpenDlg.Execute then
begin
Lines:=TStringList.Create;
Lines.LoadFromFile(PubOpenDlg.FileName);
FN:=PubOpenDlg.FileName;
AssignFile(MyFile,FN);
ReSet(MyFile);
for Num:=0 to Lines.Count-1 do
begin
ReadLn(MyFile,S);
if URLListBox.Items.IndexOf(LowerCase(S))=-1 then
URLListBox.Items.Add(LowerCase(S));
end;
CloseFile(MyFile);
end;
end;

procedure TMeshworkFairyForm.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked then
begin
try
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
OpenKey( '/Software/Microsoft/Internet Explorer', TRUE );
deletekey('TypedUrls');
createkey('TypedUrls');
finally
free;
end;
showmessage('IE地址栏网址清空完毕!,需重新打开IE后有效！');
except
showmessage('IE地址栏网址无法清空，请重启后再试!');
end;
end
else
exit;
end;

procedure TMeshworkFairyForm.OtherSetCheckBoxClick(Sender: TObject);
begin
if OtherSetCheckBox.Checked then
begin
OtherSetGroupBox.Enabled := True;
ClearIETempSpeedBtn.Enabled := True;
ClearIEHistorySpeedBtn.Enabled := True;
ClearDocumentSpeedBtn.Enabled := True;
ClearIEAddressSpeedBtn.Enabled := True;
ClearIEFavoritesSpeedBtn.Enabled := True;
end
else
begin
OtherSetGroupBox.Enabled := False;
ClearIETempSpeedBtn.Enabled := False;
ClearIEHistorySpeedBtn.Enabled := False;
ClearDocumentSpeedBtn.Enabled := False;
ClearIEAddressSpeedBtn.Enabled := False;
ClearIEFavoritesSpeedBtn.Enabled := False;
end;
end;

procedure TMeshworkFairyForm.ModifySpeedBtnClick(Sender: TObject);
var
OldPasswordText: String;
begin
OldPasswordText := OldPassword.Text;
if OldPasswordText<>'12345' then
begin
ShowMessage('原密码输入错误');
Exit;
end;
if NewPassword.Text <> ConfigPassword.Text then
Showmessage('两次输入的密码不一致');
end;

刀剑如梦 (2004-05-30 0:28:23)
unit PublicUnit;

interface

uses Windows, Messages, SysUtils, Forms, ComObj, ShlObj, ShellAPI;

implementation

type
TSTATURL = record
cbSize: DWORD;
pwcsUrl: DWORD;
pwcsTitle: DWORD;
ftLastVisited: FILETIME;
ftLastUpdated: FILETIME;
ftExpires: FILETIME;
dwFlags: DWORD;
end;

type
IEnumSTATURL = interface(IUnknown)
['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
function Skip(celt: Longint): HRESULT; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
end;

type
IUrlHistoryStg = interface(IUnknown)
['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;
function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;
function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall;
function BindToObject(pocsUrl: PWideChar; var riid: TGUID; out ppvOut: Pointer): HResult; stdcall;
function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
end;

type
IUrlHistoryStg2 = interface(IUrlHistoryStg)
['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;
fWriteHistory: Integer; var poctNotify: Pointer;
const punkISFolder: IUnknown): HResult; stdcall;
function ClearHistory: HResult; stdcall;
end;

//------------------------------------------------------------------------------
//------------------------------清除IE历史记录----------------------------------
//------------------------------------------------------------------------------
function ClearIEHistory: Integer;
const
CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';
var
IEHistory:IUrlHistoryStg2;
begin
IEHistory:=CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;
IEHistory.ClearHistory;
end;
//------------------------------------------------------------------------------
//------------------------------获取系统路径----------------------------------
//------------------------------------------------------------------------------
function GetWinDir: String;
var
Buf: array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(Buf, MAX_PATH);
Result := Buf;
if Result[Length(Result)]<>'/' then Result := Result + '/';
end;
//------------------------------------------------------------------------------
//----------------------按ctrl+Alt+Del不出现在任务栏中--------------------------
//------------------------------------------------------------------------------
function RegisterServiceProcess(dwprocessID,dwType:Integer):Integer;
stdcall;external 'KERNEL32.DLL';
//RegisterServiceProcess(GetCurrentProcessID,1);
//------------------------------------------------------------------------------
//------------------------------清除文档记录------------------------------------
//------------------------------------------------------------------------------
procedure MyDeleteFiles(Dir, Filetype: String);
var SearchRec : TSearchRec;
begin
FindFirst(Dir + '/' + FileType , $00000020 , SearchRec);
if SearchRec.Name = '' then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
DeleteFile(Pchar(Dir + '/' + SearchRec.Name));
while FindNext(SearchRec) = 0 do
DeleteFile(Pchar(Dir + '/' + SearchRec.Name));
SysUtils.FindClose(SearchRec);
end;

lijing88688 (2004-05-30 0:44:34)
用刀剑如梦的代码没错!我就是这样搞定的!

zjan521 (2004-05-30 1:14:11)
你这个和IE的分级管理功能是一样的嘛,如果时间紧,那么你就直接利用分级管理的功能,查查注册表的相关位置,包括是否能够在程序当中设置pass或者把IE选项的分级管理屏蔽掉.

或者学习3721的技术,至少3721如果安装之后很难卸载,而且可以即时获取url和重定向url,

刘李子 (2004-06-02 22:10:24)
gz

xuming (2004-06-13 10:34:45)
谢谢大家如此关注
继续提前。
呵呵

xuming (2004-06-13 10:42:14)
对了，老板说想从底层考虑。
我建议他买费尔防火墙的源代码，
你们说这样好不好？

satanmonkey (2004-06-13 17:30:39)
费尔不错

iDevCN (2004-06-13 23:28:48)
可以考虑使用网络执法官这个软件，比较厉害喔