基本信息:
TreeView 是一个显示树型结构的控件,每一个节点都是一个新类,使用具有代表性
每个节点都有四个值:
TEXT:显示文字 Image Index:显示图形序号
Selected Index:
State Index:
(1)建立目录项(本例中使用的TREEVIEW名称为:TvwTips)
增加根目录下的节点:(节点)
var
CatNode : TTreeNode; //先建立一个TREEVIEW使用的子对象
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
{ 在根标题下建立一个新的子标题 }
CatNode := TvwTips.Items.AddChild(TvwTips.Items.GetFirstNode,'New Category' );
CatNode.ImageIndex := 1;
CatNode.SelectedIndex := 2;
CatNode.EditText; { 允许用户改变这个标题 }
end;
增加下一级目录(内容):
var
ParentNode, TipNode : TTreeNode; //先建立TREEVIEW使用的子对象
VersionNum : Integer;
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
VersionNum := TMenuItem( Sender ).Tag; { Ver num of new tip }
ParentNode := TvwTips.Selected; { 取出当前的选中节点 }
if ParentNode.Level = nlTip then{ Parent cannot be a tip node }
ParentNode := TvwTips.Selected.Parent;
TipNode := TvwTips.Items.AddChildObject( ParentNode,'NewSubject',Pointer( VersionNum ) );
TipNode.ImageIndex := 3; { Normal tip bitmap }
TipNode.SelectedIndex := 4; { Highlighted tip bitmap }
TipNode.MakeVisible; { Move new tip node into view }
TipNode.EditText; { Immediately allow user to edit subject }
EnableTreeViewFunctions( TipNode.Level );
RtfTip.Clear;
RtfTip.Modified := False;
end;
(2)说明
TvwTips.Items.GetFirstNode 返回TREEVIEW的第一个节点,函数类型为:TTreeNode
TvwTips.Items.Count 返回当前TreeView的全部节点数,整数
TvwTips.Selected.Level 返回当前选中节点的在目录树中的级别,根目录为0
TvwTips.Selected.Parent 返回当前选中节点上级节点,函数类型为:TTreeNode
※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
TreeView节点导出为文本
procedure ExpandChild(const ANode: TTreeNode; const AList: TStrings;
const ALevel: string = '');
//展开子节点
var
J: Integer;
begin
if ANode.Count = 0 then Exit;
for J := 0 to ANode.Count - 2 do
begin
AList.Add(ALevel + '├' + ANode.Item[J].Text);
ExpandChild(ANode.Item[J], AList, ALevel + '│');
end;
AList.Add(ALevel + '└' + ANode.Item[ANode.Count - 1].Text);
ExpandChild(ANode.Item[ANode.Count - 1], AList, ALevel + ' ');
end;
procedure ExportNode(const ANode: TTreeNode; const AFileName: string);
//导出节点
var
AList : TStrings;
begin
AList := TStringList.Create;
try
AList.Add(ANode.Text);
ExpandChild(ANode, AList);
AList.SaveToFile(AFileName);
finally
AList.Free;
end;
end;
begin
SaveDlg_DirCapture.Filter := 'Text files|*.txt';
SaveDlg_DirCapture.FileName := cbx_Subject.Text + '快照.txt';
if SaveDlg_DirCapture.Execute then
ExportNode(TV_Main.Selected, SaveDlg_DirCapture.FileName);
end;
※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
待续……
2005-5-18 17:11:01
发表评语»»»
2005-5-26 4:43:01 TreeView的遍历摘 要:对TreeView的遍历
关键字:TreeView
类 别:Delphi & IDE
E-Mail:iloveyou9595@sina.com
function TForm1.AllOverTreeView(node:TTreenode):TTreenode;
begin
while node<>nil do
begin
if node.HasChildren then
begin
node:=node.getFirstChild;
allovertreeview(node);
node:=node.Parent;
end;
if node.getNextSibling<>nil then
node:=node.getNextSibling
else
exit;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
parentnode:TTreenode;
begin
parentnode:=Mytreeview.Items.GetFirstNode;
AllOverTreeView(parentnode);
end;
------------------------------------------------------
遍历TreeView的方法有很多,我经过反复编程实现,上面是我用最少的代码实现TreeView的遍历。效果还不错。
利用这个对所有节点的遍历,我们可以很方便的对所有节点进行各种操作。例如:统计每层节点的个数、对
满足要求的节点进行操作、等等。
2005-5-26 4:44:07 给TreeView中的每一项加上可复选框的CheckBoxTreeView不能像ListView中的CheckBox一样多选,只能用StateImage,效果不错,但不是CheckBox,而是画一个打勾的图形(Index=3)。当某个Item被选中后,前面就出现这个打勾的图标,当再次点击时,打勾的图标就消失。
在TreeView的OnClick事件中添加如下代码:
if TreeView2.Selected.StateIndex <> 3 then
TreeView2.Selected.StateIndex :=3
else
TreeView2.Selected.StateIndex := -1;
2005-5-26 5:11:55 查找TreeView节点 从当前节点的子节点开始查找,并不仅查找子节点,也会遍历同级和父级节点
procedure TFrmWindowView.btnSearchClick(Sender: TObject);
//查找节点内容
function FindChild(
const ANode : TTreeNode;
const AText : string;
const AStart : Integer = 0
):Boolean;
//遍历子节点
var
i : Integer;
begin
Result := False;
for i := AStart to ANode.Count - 1 do
begin
if Pos(AText,UpperCase(ANode.Item[i].Text)) > 0 then
begin
ANode.Item[i].Selected := True;
Result := True;
Exit;
end;
Result := FindChild(ANode.Item[i],AText);
if Result then Exit;
end;
end;
function FindParent(
const ANode : TTreeNode;
const AText : string
):Boolean;
//遍历父节点
begin
Result := False;
if not Assigned(ANode.Parent) then Exit;
Result := FindChild(ANode.Parent,AText,ANode.Index + 1);
if not Result then
Result := FindParent(ANode.Parent,AText);
end;
var
sSearchText : string;
begin
if not Assigned(tv.Selected) or (edtSearch.Text = '') then Exit;
sSearchText := UpperCase(edtSearch.Text);
if not FindChild(tv.Selected, sSearchText) then
FindParent(tv.Selected, sSearchText);
end;
2005-5-26 5:12:25 导出TreeView到文本文件下面的过程可以把TreeView导出为文本文件
procedure ExpandChild(
const ANode : TTreeNode;
const AList : TStrings;
const ALevel : string = ''
);
//展开子节点
var
i : Integer;
begin
if ANode.Count = 0 then Exit;
for i := 0 to ANode.Count - 2 do
begin
AList.Add(ALevel + '├' +ANode.Item[i].Text);
ExpandChild(ANode.Item[i],AList,ALevel + '│');
end;
AList.Add(ALevel + '└' +ANode.Item[ANode.Count-1].Text);
ExpandChild(ANode.Item[ANode.Count-1],AList,ALevel + ' ');
end;
procedure ExportNode(
const ANode : TTreeNode;
const AFileName : string
);
//导出节点
var
aList : TStrings;
begin
aList := TStringList.Create;
try
aList.Add(ANode.Text);
ExpandChild(ANode,aList);
aList.SaveToFile(AFileName);
finally
aList.Free;
end;
end;
调用:
if dlgSave.Execute then
ExportNode(TreeView1.Selected,dlgSave.FileName);
结果示例:
窗口查看器 - TFrmWindowView
├(空) - TListBox
├(空) - TCoolBar
│├(空) - TToolBar
│├(空) - TToolBar
││├(空) - TPanel
│││├搜索 - TButton
│││└(空) - TEdit
││└搜索文本: - TPanel
│└(空) - TToolBar
│ └捕获 - TPanelEx
├(空) - TStatusBar
├(空) - TTreeView
└(空) - TListBox
2005-6-12 9:47:52
发表评语»»»
2005-6-12 10:20:15 flash 和 登陆 窗体的通常做法。这个过程是实际建立过程中取消资源占用。
流程: 首先显示splash 过程中创建并初始化
创建登陆窗体,
创建主窗体
释放splash窗体
显示登陆窗体
处理权限读取和一些全局变量的操作。
释放登陆窗体,--使命完成了,可以休息了。
运行程序--主角上场了
}
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},//登陆单元
Unit2 in 'Unit2.pas' {Form2},//splash单元
Unit3 in 'Unit3.pas' {Form3},//Main单元
Unit4 in 'Unit4.pas'; //public 单元可以用来传递全局变量
{$R *.res}
begin
form2 := Tform2.Create(application);
try
form2.Show;
form2.Refresh;
Application.Initialize;
Form1 := TForm1.Create(application);
Application.CreateForm(TForm3, Form3);
finally
Form2.Free;
form1.ShowModal;
form1.Free;
Application.Run;
end;
end.//很简单吧,那里不合理的或者有什么更好的办法大家指出来
2005-6-14 22:56:50 票打的最快驱动 票打的最快驱动
关键字: 对LPT输出
分类: 开发技巧
密级: 公开
(评分: , 回复: 0, 阅读: 292) »»
原理:直接对“LPT1”端口进行输出,使用此种方式打印速度是最快的。
对文本文件进行写操作,当文本文件的文件名为“LPT”或“COM”等保留字里,即是对指定端口写。
源代码截自“吉胜超市POS”
my:='lpt1';
filehandle:=fileopen(my,fmopenwrite);
fileclose(filehandle);
if filehandle<0 then
begin
messagebox(handle,'lpt1错误','错误',mb_iconerror);
exit;
end
else
begin
assignfile(tf,my);
rewrite(tf);
writeln(tf,chr(27)+chr(112)+chr(0)+chr(18)+chr(22));
with query1 do
begin
sql.Clear;
sql.Add('select 企业名称 from 企业档案');
close;
open;
end;
writeln(tf,' '+query1.fieldbyname('企业名称').AsString);
if strtofloat(label6.Caption)<0 then
writeln(tf,' '+'退货单')
else
writeln(tf,' '+'销售单');
writeln(tf,'流 水 号:'+form1.StatusBar1.Panels[1].Text);
writeln(tf,'销售日期:'+datetimetostr(now));
writeln(tf,'收 款 员:'+form1.StatusBar1.Panels[3].Text);
writeln(tf,'--------------------------------');
writeln(tf,'商品编码'+' '+'数量'+' '+'单价'+' '+'金额');
writeln(tf,'--------------------------------');
for a:=1 to form1.StringGrid1.RowCount-2 do
begin
writeln(tf,form1.StringGrid1.Cells[2,a]);
writeln(tf,form1.StringGrid1.Cells[1,a]+' '+form1.StringGrid1.Cells[5,a]+' '+form1.StringGrid1.Cells[4,a]+' '+form1.StringGrid1.Cells[6,a]);
end;
writeln(tf,'--------------------------------');
writeln(tf,'合计金额:'+' '+Label8.Caption);
writeln(tf,'找零金额:'+' '+label9.Caption);
writeln(tf,'谢谢惠顾,欢迎下次光临');
writeln(tf,'请妥善保管您的电脑小票');
writeln(tf,'');
writeln(tf,'');
writeln(tf,'');
writeln(tf,'');
writeln(tf,'');
closefile(tf);
2005-6-16 12:34:29 关于程序的自启动控制Windows 关于程序的自启动控制Windows
首先,我要说明的是我不是要作一个网吧管理软件,大家一定都去过网吧吧?
一般的网吧管理软件,如pubwin,启动的时候,会先控制windows操作系统,然后再让用户输入用户名和密码,才能进入系统,并且屏蔽了所有的系统热键……
现在,老板让我作的一个商业软件,他要求我的这个软件随windows启动而启动(这个好说,大家都知道)在进入系统后,整个系统只能运行我的软件,所有的系统热键被屏蔽,一些Explorer能用的功能,如打开文件夹,改名啊,都不能用,
也就是说,让用户不能进入Explorer外壳,只能在我的软件框架中运行(和网吧的客户机有些像)
请问,具体怎么写程序啊?给个思路好不好?有源码更好!
来自:wanghaiou, 时间:2005-5-31 21:30:51, ID:3090464
procedure TMainForm.FormCreate(Sender: TObject);
begin
//屏蔽alt_f4键
HotKeyId := GlobalAddAtom('HotKey') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_f4);
//屏蔽alt_Tab键
HotKeyId := GlobalAddAtom('HotKey1') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_tab);
end;
//
//12.终止某一正在运行的进程
//
procedure HideProcess(ProcessName:string);
var h:Thandle;
a:Dword;
p:ProcessInfo;
i:integer;
Current:TList;
begin
ProcessList(current);
for i:=0 to current.Count-1 do
begin
p:=Current.Items[i];
if ansiuppercase(p.ExeFile)=ansiuppercase(ProcessName) then
begin
h:=OpenProcess(Process_All_Access,true,p.ProcessID);
GetExitCodeProcess(h,a);
TerminateProcess(h,a);
end;
end;
end;
在一个时间空间里写上
//关闭EXPLORER.EXE
HideProcess('EXPLORER.EXE');
HideProcess('explorer.exe');
//屏蔽任务管理器
HideProcess('TASKMGR.EXE');
HideProcess('taskmgr.exe');
这样你的程序可以屏蔽 任务管理器,EXPLORER.EXE,alt_Tab,alt_f4
最后把你的程序的名称写在注册表的
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon
Shell 项的下
注意要这么写 EXPLORER.exe,你的程序.exe
这可是我和5000个学生对抗了大半年的成果哦!
同时运行在500台机器上,目前已经有学生很难破解我的网管软件了!
来自:bloodymary, 时间:2005-6-1 10:01:30, ID:3090785
顶!
来自:bloodymary, 时间:2005-6-1 11:12:42, ID:3090886
to wanghaiou
谢谢了,请问,我在Form.create中添加锁定鼠标移动区域的代码
procedure TForm1.FormCreate(Sender: TObject);
var
t : trect;
begin
t := form1.BoundsRect;
mapwindowpoints(handle,handle,t,2);
clipcursor(@t);
end;
为什么没有用?
而在click事件中
procedure TForm1.Button1Click(Sender: TObject);
var
t : trect;
begin
t := form1.BoundsRect;
mapwindowpoints(handle,handle,t,2);
clipcursor(@t);
end;有用,
这是怎么回事?因为我想在FormCreate的时候锁定鼠标
来自:wanghaiou, 时间:2005-6-1 14:11:43, ID:3091057
其实放到按钮里也是不好使的,
不信你把窗体挪个地方试验一下,
你应该把这个段代码放到一个时钟控件里面,让他每隔100执行一下。
或者象我甘脆做个线程。
来自:bloodymary, 时间:2005-6-1 15:18:42, ID:3091155
想求甚解^^^^^^^^^
为什么呢?
为什么在OnCreate中就无效了?
强人来解释一下?
来自:Toysun, 时间:2005-6-1 15:31:50, ID:3091171
把系统shell换成你自己的程序
启动后屏蔽系统热键
最后用你的程序启动explorer
来自:wanghaiou, 时间:2005-6-1 15:34:21, ID:3091175
你已经知道这样做不行了就可以了呗!
已经告诉你解决办法了,
为了保险你最好是做个线程,实时的每隔0.1秒就锁定一次。
因为任何一个系统消息都有可能使你的一次锁定无效!!
来自:wanghaiou, 时间:2005-6-1 15:37:22, ID:3091178
把系统shell换成你自己的程序
启动后屏蔽系统热键
最后用你的程序启动explorer
不知道这位仁兄自己试验过没有!
试验一下再上来发言吧!
要不然会帮倒忙的!!
来自:爱不到要偷, 时间:2005-6-1 15:39:25, ID:3091181
控制系统热键可以用Windows API
来自:Toysun, 时间:2005-6-1 16:57:58, ID:3091266
~o~
说明:适合于2000以上win系列
来自:wanghaiou, 时间:2005-6-1 17:27:30, ID:3091294
照你那个方法你屏幕最下面的开始菜单的那个工具栏还能出来了吗?
来自:bloodymary, 时间:2005-6-1 20:42:49, ID:3091424
TO wanghaiou
谢谢!
你有没有可以屏蔽系统热键的程序源码?我在网上下了几个,都不能用;
好像使用消息钩子可以屏蔽
ctrl+alt+del,alt+f4,win……等键
如果有的话,分马上送上,谢谢!!!!!
来自:wanghaiou, 时间:2005-6-1 20:59:36, ID:3091439
procedure TMainForm.FormCreate(Sender: TObject);
begin
//屏蔽alt_f4键
HotKeyId := GlobalAddAtom('HotKey') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_f4);
//屏蔽alt_Tab键
HotKeyId := GlobalAddAtom('HotKey1') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_tab);
end;
//
//12.终止某一正在运行的进程
//
procedure HideProcess(ProcessName:string);
var h:Thandle;
a:Dword;
p:ProcessInfo;
i:integer;
Current:TList;
begin
ProcessList(current);
for i:=0 to current.Count-1 do
begin
p:=Current.Items[i];
if ansiuppercase(p.ExeFile)=ansiuppercase(ProcessName) then
begin
h:=OpenProcess(Process_All_Access,true,p.ProcessID);
GetExitCodeProcess(h,a);
TerminateProcess(h,a);
end;
end;
end;
在一个时间空间里写上
//关闭EXPLORER.EXE
HideProcess('EXPLORER.EXE');
HideProcess('explorer.exe');
//屏蔽任务管理器
HideProcess('TASKMGR.EXE');
HideProcess('taskmgr.exe');
你好好看看,
//屏蔽alt_f4键
HotKeyId := GlobalAddAtom('HotKey') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_f4);
//屏蔽alt_Tab键
HotKeyId := GlobalAddAtom('HotKey1') - $C000;
RegisterHotKey(Handle, hotkeyid, Mod_Alt,vk_tab);
//关闭EXPLORER.EXE
HideProcess('EXPLORER.EXE');
HideProcess('explorer.exe');
//屏蔽任务管理器-相当于屏蔽 Ctrl+Alt+Del
HideProcess('TASKMGR.EXE');
HideProcess('taskmgr.exe');
来自:bloodymary, 时间:2005-6-1 21:57:34, ID:3091494
我在调试,
ProcessList这个过程是哪儿的?我找不到
要用什么单元?
来自:bloodymary, 时间:2005-6-1 22:00:59, ID:3091497
ProcessInfo不知是什么参数……
来自:wanghaiou, 时间:2005-6-2 7:34:28, ID:3091595
//
//11.取得当前进程列表
//
procedure ProcessList(Var pList:TList);
var p:ProcessInfo;
ok:Bool;
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
begin
pList:=TList.Create;
pList.Clear;
ProcessListHandle:=CreateToolHelp32SnapShot(TH32cs_SnapProcess,0);
ProcessStruct.dwSize:=SizeOf(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while integer(ok)<>0 do
begin
New(p);
p.ExeFile:=ProcessStruct.szExeFile;
p.ProcessID:=ProcessStruct.th32ProcessID;
pList.Add(p);
ok:=Process32Next(ProcessListHandle,ProcessStruct);
end;
// dispose(p); //释放内存
end;
来自:wanghaiou, 时间:2005-6-2 7:36:58, ID:3091596
ProcessInfo不知是什么参数……
看如下代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
///
TProcessInfo=Record
ExeFile:string;
ProcessID:Dword;
end;
ProcessInfo=^TProcessInfo;
///
TForm1 = class(TForm)
Button1: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
来自:bloodymary, 时间:2005-6-2 11:50:49, ID:3091931
[Error] Unit1.pas(41): Undeclared identifier: 'TProcessEntry32'
[Error] Unit1.pas(45): Undeclared identifier: 'CreateToolHelp32SnapShot'
[Error] Unit1.pas(45): Undeclared identifier: 'TH32cs_SnapProcess'
[Error] Unit1.pas(46): Missing operator or semicolon
[Error] Unit1.pas(47): Undeclared identifier: 'Process32First'
[Error] Unit1.pas(51): Missing operator or semicolon
[Error] Unit1.pas(52): Missing operator or semicolon
[Error] Unit1.pas(54): Undeclared identifier: 'Process32Next'
[Error] Unit1.pas(12): Unsatisfied forward or external declaration: 'TForm1.HideProcess'
[Error] Unit1.pas(13): Unsatisfied forward or external declaration: 'TForm1.ProcessList'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'
wanghaiou:你能不能调一下?你给我的好多参数和过程我都不能用……以上是我的调试错误
来自:bloodymary, 时间:2005-6-2 12:03:58, ID:3091950
奇怪,我明明在windows sdk 中发现了'CreateToolHelp32SnapShot'
'TH32cs_SnapProcess'为什么不能引用???
我用了windows 单元了啊……
来自:wanghaiou, 时间:2005-6-2 12:14:29, ID:3091955
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,TlHelp32,imm;
type
//屏蔽系统键
Thidekeys = CLASS(TThread)
private
Tim:integer;
protected
procedure execute; override;
end;
TProcessInfo=Record
ExeFile:string;
ProcessID:Dword;
end;
ProcessInfo=^TProcessInfo;//
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
CloseBz:Bool;
HotKeyId: Integer;
{ Private declarations }
public
{ Public declarations }
end;
//
//8.将鼠标锁定在某一区域
//
procedure LockedMouse(Rect: TRect;Bz:Bool);
//
//11.取得当前进程列表
//
procedure ProcessList(Var pList:TList);
//
//12.终止某一正在运行的进程
//
procedure HideProcess(ProcessName:string);
var
Form1: TForm1;
Thidekeys1:Thidekeys;
implementation
{$R *.dfm}
//屏蔽系统键和任务管理器进程
///
procedure Thidekeys.execute;
var
myhkl:hkl;
rect1:trect;
begin
while Form1.CloseBz=false do
begin
//将鼠标锁定在某一范围
rect1.Left:=10;
rect1.Top:=10;
rect1.Right:=screen.Width-20;
rect1.Bottom:=screen.Height-20;
LockedMouse(rect1,true);
//关闭中文输入法
myhkl:=GetKeyBoardLayOut(0);
if ImmIsIME(myhkl) then
immsimulateHotkey(handle,IME_CHotKey_IME_NonIME_Toggle);
//关闭EXPLORER.EXE
HideProcess('EXPLORER.EXE');
HideProcess('explorer.exe');
//屏蔽任务管理器
HideProcess('TASKMGR.EXE');
HideProcess('taskmgr.exe');
Form1.BringToFront;
sleep(100);
end;
end;
//
//8.将鼠标锁定在某一区域
//
procedure LockedMouse(Rect: TRect;Bz:Bool);
var
Temp:integer;
Rect1:Trect;
begin
if Bz=true then
begin
rect1.Left:=rect.Left;
Rect1.Top:=rect.Top;
Rect1.Bottom:=rect.Bottom;
Rect1.Right:=rect.Right;
end
else
begin
rect1.Left:=0;
Rect1.Top:=0;
Rect1.Bottom:=screen.DesktopHeight;
Rect1.Right:=Screen.DesktopWidth;
end;
ClipCursor(@rect1);
SystemParametersInfo(spi_screensaverrunning,1,@temp,0);
end;
//11.取得当前进程列表
//
procedure ProcessList(Var pList:TList);
var
p:ProcessInfo;
ok:Bool;
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
begin
pList:=TList.Create;
pList.Clear;
ProcessListHandle:=CreateToolHelp32SnapShot(TH32cs_SnapProcess,0);
ProcessStruct.dwSize:=SizeOf(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while integer(ok)<>0 do
begin
New(p);
p.ExeFile:=ProcessStruct.szExeFile;
p.ProcessID:=ProcessStruct.th32ProcessID;
pList.Add(p);
ok:=Process32Next(ProcessListHandle,ProcessStruct);
end;
// dispose(p); //释放内存
end;
//
//12.终止某一正在运行的进程
//
procedure HideProcess(ProcessName:string);
var h:Thandle;
a:Dword;
p:ProcessInfo;
i:integer;
Current:TList;
begin
ProcessList(current);
for i:=0 to current.Count-1 do
begin
p:=Current.Items[i];
if ansiuppercase(p.ExeFile)=ansiuppercase(ProcessName) then
begin
h:=OpenProcess(Process_All_Access,true,p.ProcessID);
GetExitCodeProcess(h,a);
TerminateProcess(h,a);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CloseBz:=true;
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CloseBz:=false;
Thidekeys1:=Thidekeys.Create(false);
//屏蔽alt_f4键
Form1.HotKeyId := GlobalAddAtom('HotKey') - $C000;
RegisterHotKey(Handle, form1.hotkeyid, Mod_Alt,vk_f4);
form1.HotKeyId := GlobalAddAtom('HotKey1') - $C000;
RegisterHotKey(Handle, form1.hotkeyid, Mod_Alt,vk_tab);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Thidekeys1.Terminate;
winexec('explorer.exe',SW_show);
end;
end.
来自:wanghaiou, 时间:2005-6-2 12:19:23, ID:3091957
我差点就把我的源码都给你了,你可知道这是我大半年的心血,你够幸运了。
再不结帖给分可说不过去了哦!
来自:bloodymary, 时间:2005-6-2 12:31:47, ID:3091971
谢谢!
以下是我的机子的情况:
我的机子操作系统是win2k advanced server
每次我
HideProcess('EXPLORER.EXE');的时候,就出错:【这时候explorer确实是消失了……可是过了3——5秒中,explorer又回来了!是不是在win2k中不能关闭explorer?可我按下
ctrl+del+alt的时候,明明可以关闭的!
是不是程序本身有错误?】
---------------------------
Project1
---------------------------
Access violation at address 004040D4 in module 'Project1.exe'. Read of address FFFFFFFF.
---------------------------
确定
---------------------------
来自:wanghaiou, 时间:2005-6-2 12:41:59, ID:3091979
你跟踪一下吧
不要着急,慢慢调
来自:bloodymary, 时间:2005-6-2 13:14:56, ID:3092013
你的可以用吗?
据说,在windows2000及以上版本中,不能屏蔽ctrl + del +alt……
来自:wanghaiou, 时间:2005-6-2 13:40:08, ID:3092035
我的办法不是不能屏蔽ctrl + del +alt…… ,
而是将任务管理器关掉
从而达到用户无法使用资源管理器的目的
来自:bloodymary, 时间:2005-6-2 13:43:59, ID:3092040
问题解决了一点,请指教:
我把
// dispose(p); //释放内存给去掉了,就不会出现溢出错误了,
请问,如果不dispose的话,是不是占用的内存会越来越多啊?
可是
,一dispose,就容易出错,这是怎么一回事?
来自:wanghaiou, 时间:2005-6-2 14:47:22, ID:3092133
你就照着我的做法
// dispose(p); //释放内存
因为在别处也有引用P;
所以你这里释放掉了,别的地方就用不了了,当然出错了!
来自:bloodymary, 时间:2005-6-2 16:18:01, ID:3092294
谢谢你的解答!
再问最后一个问题,
wanghaiou:
能不能在windows2000中屏蔽掉Ctrl+Alt+Del?
我查了一个下午,没有一个好的解决方案,也就是说,没有Delphi的源码
你又没有源码啊?
来自:bloodymary, 时间:2005-6-2 16:20:32, ID:3092301
因为,windows2000 和windows xp跟win98不一样,
它们的Ctrl+Alt+Del组合键不是那么容易屏蔽掉的,不单单是系统钩子那么简单!
需要底层的操作……
我觉得我就差这一个坎了!
来自:wanghaiou, 时间:2005-6-2 16:27:21, ID:3092314
你就别想着怎么屏蔽了,
Ctrl+Alt+Del能怎么的?不就是弹出来任务管理器吗?
我不是在线程里面在很短的时间内结束进程了吗?
这样即使用户按下Ctrl+Alt+Del,还没等任务管理器打开呢,我们就把它关闭了,
这不是一样吗
来自:wanghaiou, 时间:2005-6-2 16:30:48, ID:3092320
我已经找了半年多了,也没有找到屏蔽Ctrl+Alt+Del的方法,
如果你要是找到了告诉我一声!~
来自:bloodymary, 时间:2005-6-2 16:49:49, ID:3092364
呵呵,我要是找到了,一定会给你的!
我在timer中每0.1秒就kill explorer一次,结果在资源管理器中发现,系统的可用内存越来越少!
这样下去的话,系统迟早会崩溃!
来自:wanghaiou, 时间:2005-6-2 16:53:59, ID:3092371
向我那样
放到线程里面就没有事情了
可以把时间间隔调长点
0.5也没有关系
来自:bloodymary, 时间:2005-6-2 16:58:23, ID:3092381
测试发现,每秒种的内存占用会增加200kb左右!
系统句柄数会增加10个左右……
如果一直调用HIdeProcess('explorer.exe')的话,我怕系统最终会崩溃掉……
来自:bloodymary, 时间:2005-6-2 17:10:15, ID:3092403
to wanghaiou:
不行啊,以下是我的源代码,请你看看:【还是每隔一秒多9个系统句柄,内存多占用200kb左右……】
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,TLhelp32, StdCtrls, ExtCtrls;
type
//屏蔽系统键
Thidekeys = CLASS(TThread)
private
Tim:integer;
protected
procedure execute; override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
///
TProcessInfo=Record
ExeFile:string;
ProcessID:Dword;
end;
ProcessInfo=^TProcessInfo;
///
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure ProcessList(Var pList:TList);
var p:ProcessInfo;
ok:Bool;
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
begin
pList:=TList.Create;
pList.Clear;
ProcessListHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize := SizeOf(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while integer(ok)<>0 do
begin
New(p);
p.ExeFile:=ProcessStruct.szExeFile;
p.ProcessID:=ProcessStruct.th32ProcessID;
pList.Add(p);
ok:=Process32Next(ProcessListHandle,ProcessStruct);
end;
// dispose(p); //释放内存
end;
procedure HideProcess(ProcessName:string);
var h:Thandle;
a:Dword;
p:ProcessInfo;
i:integer;
Current:TList;
begin
ProcessList(current);
for i:=0 to current.Count-1 do
begin
p:=Current.Items[i];
if ansiuppercase(p.ExeFile)=ansiuppercase(ProcessName) then
begin
h:=OpenProcess(Process_All_Access,true,p.ProcessID);
GetExitCodeProcess(h,a);
TerminateProcess(h,a);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
HotKeyId : Word;
test : Thidekeys;
begin
//屏蔽alt_f4键
HotKeyId := GlobalAddAtom('HotKey') - $C000;
RegisterHotKey(0, hotkeyid, Mod_Alt,vk_f4);
//屏蔽alt_Tab键
HotKeyId := GlobalAddAtom('HotKey1') - $C000;
RegisterHotKey(0, hotkeyid, Mod_Alt,vk_tab);
// hideprocess('explorer.exe');
test := Thidekeys.Create(false);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
HIDEPROCESS('EXPLORER.EXE');
end;
{ Thidekeys }
procedure Thidekeys.execute;
begin
inherited;
form1.Timer1.Enabled := true;
end;
end.
来自:bloodymary, 时间:2005-6-2 17:28:07, ID:3092424
怎么样,你也发现了吗?
来自:fbms, 时间:2005-6-2 18:01:37, ID:3092471
删除explorer.exe.用你自己写的explorer.exe替换他.
来自:bloodymary, 时间:2005-6-3 8:35:49, ID:3092804
to fbms:
不行!这样的话,我的windows不就废了!
我还得提供一个让用户能回到正常 windows 的密码呢!
来自:wanghaiou, 时间:2005-6-3 8:42:35, ID:3092814
procedure TForm1.Timer1Timer(Sender: TObject);
begin
HIDEPROCESS('EXPLORER.EXE');
end;
{ Thidekeys }
procedure Thidekeys.execute;
begin
inherited;
form1.Timer1.Enabled := true;
end;
这样不行
替换成
procedure Thidekeys.execute;
begin
while 1=1 do
begin
HIDEPROCESS('EXPLORER.EXE');
end;
end;
来自:wanghaiou, 时间:2005-6-3 8:48:08, ID:3092819
test : Thidekeys;
定义的地方也不对
你看看我在什么地方定义的
我给你的例子肯定是最佳的写法了,我都研究大半年了,现在根本就没有人可以越过我的程序进入到系统!
你好好研究一下呀!
来自:dongy_143, 时间:2005-6-3 9:01:00, ID:3092834
好象系统里有好几个explorer.exe进程;XP
来自:wanghaiou, 时间:2005-6-3 9:10:19, ID:3092847
把你的邮箱给我
我给你发个例子程序
来自:bloodymary, 时间:2005-6-3 9:44:51, ID:3092910
我的油箱:
foraccount@126.com
谢谢!
来自:zhengdehei, 时间:2005-6-3 10:03:43, ID:3092950
procedure TForm1.Timer1Timer(Sender: TObject);
begin
HIDEPROCESS('EXPLORER.EXE');
end;
{ Thidekeys }
procedure Thidekeys.execute;
begin
inherited;
form1.Timer1.Enabled := true;
end;
用线程控制主线程的TIMER关闭EXPLORER,会加剧系统开销
其实就sleep就可以了
来自:wanghaiou, 时间:2005-6-3 10:09:09, ID:3092961
例子已经给你了,你看看我是怎么做的就知道了
来自:bloodymary, 时间:2005-6-3 11:28:45, ID:3093075
TO zhengdehei
SLEEP?呵呵,sleep可以关闭explorer线程?请指教……
to wanghaiou:
你的邮件我收到了,我运行了一下,还是
【测试发现,每秒种的内存占用会增加200kb左右!
系统句柄数会增加10个左右……】
这样,一定会加剧系统开销,最终导致系统崩溃的!所以,我希望有一个方法,不会使系统的开销一直增加!
你的程序写的不错!如果有不加剧系统开销的方法就好了,你可以在你自己的机子上测试一下!
如果,我找到了屏蔽ctrl + del +alt的方法,我再发给你!