基本信息:
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的方法，我再发给你！
