来来来，看看你的水平有多高！——Aimingoo送分项目(超过600大元) (0分)

就是，程序的可读性其实很重要的，只要大家、评委觉得精简，体现技巧，就达到目的了，

呵呵，找了找以前写的东西，长了点，可能不符合要求吧
{-----------------------------------------------------------------------------
Unit Name: ShellExecuteHookObj
Author: hubdog
Purpose: 外壳ShellExecute函数截取扩展
History: 2001-05-01
-----------------------------------------------------------------------------}

unit ShellExecuteHookObj;
interface
uses
Windows, ActiveX, ComObj, ShlObj, ShellAPI;
type
TTShellExecuteHook = class(TComObject, IShellExecuteHook)
protected
function Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
stdcall;
end;
const
Class_TShellExecuteHook: TGUID = '{935FA400-243D-11D3-B06E-857B2AE2BE64}';
implementation
resourcestring
sCreateRegKeyError = '创建注册表项失败';
type
TShellExComObjectFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean);
override;
end;
{ TShellExComObjectFactory }
function TTShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var
FileName: string;
begin
Result := S_FALSE;
with ShellExecuteInfo do
begin
FileName := UpperCase(ExtractFileName(lpFile));
if Pos('NOTEPAD', FileName) = 1 then
begin
Result := S_OK;
hInstApp := 32;
MessageBox(Wnd, '不允许记事本运行！', '错误', MB_OK or MB_ICONERROR);
end;
end;
end;

procedure TShellExComObjectFactory.UpdateRegistry(Register: Boolean);
const
hellExecuteHooksKey = 'SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/ShellExecuteHooks';
var
Handle: HKey;
Status, Disposition: Integer;
ClassID: string;
begin
ClassID := GUIDToString(Class_TShellExecuteHook);
if Register then
begin
Status := RegCreateKeyEx(HKEY_LOCAL_MACHINE, PChar(ShellExecuteHooksKey), 0, '',
REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle, @Disposition);
if Status = 0 then
begin
Status := RegSetValueEx(Handle, PChar(ClassID), 0, REG_SZ,
PChar(Description), Length(Description) + 1);
RegCloseKey(Handle);
end;
end else
begin
Status := RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(ShellExecuteHooksKey), 0,
KEY_READ or KEY_WRITE, Handle);
if Status = 0 then
begin
Status := RegDeleteValue(Handle, PChar(ClassID));
RegCloseKey(Handle);
end;
end;
if Status <> 0 then
raise EOleError.Create(sCreateRegKeyError);
inherited UpdateRegistry(Register);
end;

initialization
TShellExComObjectFactory.Create(ComServer, TTShellExecuteHook, Class_TShellExecuteHook,
'TShellExecuteHook', 'ShellExecute hook sample', ciMultiInstance, tmApartment);
end.

也可以将execute改写为下面代码，看看文件里都记录了些什么东东
function TTShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var
FileStream: TFileStream;
a:TStringList;
S:string;
begin
Result := S_FALSE;
with ShellExecuteInfo do
begin
FileStream:=TFileStream.Create('c:/shellexecutehook.txt',fmopenwrite);
S:=string(lpVerb)+':'+string(lpFile)+DateTimeToStr(Now)+#13#10;
FileStream.Seek(FileStream.Size,soFrombegin
ning);
FileStream.Write(PChar(S)^,Length(S));
FileStream.Free;
end;
end;

[?]

看

下面的程序利用多线程的不可预测性原理产生6个0..999999的随机数。
详见： http://www.delphibbs.com/delphibbs/dispq.asp?lid=650976
{
Unit Name: Thd
Author: creation_zy ( creation-zy )
Purpose: 随机数产生
History: 2001-09-29
}
program Thd;
{$APPTYPE CONSOLE}
uses SysUtils,Classes,Windows;
type
PInt=^Integer;
TGo = class(TThread)
PtrInt;
PWaitInt;
procedure Execute;
override;
procedure Init(PtrInt,WaitPIInt);
end;

procedure TGo.Execute;
begin
while PWait^=0 do
Sleep(1);
while not Terminated do
Inc(Ptr^);
end;
procedure TGo.Init(PtrInt,WaitPI: PInt);
begin
Ptr:=PtrInt;
PWait:=WaitPI;
end;

var
RecInt:array[1..6]of Integer;
Thds:array[1..6]of TGo;
i,Start:Integer;
begin
Start:=0;
for i:=1 to 6 do
begin
Thds:=TGo.Create(false);
RecInt:=0;
Thds.Init(@RecInt,@Start);
Thds.Priority:=tpTimeCritical;
end;
Start:=1;
Sleep(20);
for i:=1 to 6 do
Thds.Terminate;
for i:=1 to 6 do
Writeln(RecInt mod 1000000);
end.

我尽了最大努力，还是有650多Byte，55555555555555

好玩。

aimingoo, 这次活动，您请多费心了。请您作为执行主席吧。
组织方面：
- 把投稿的程序收集好。
- 为每一个程序起草一份简短评价，以便将来找评委传阅。
- 尽快想办法贴一个统计字数的程序给大家。
- 可以考虑为此活动专门开个网页。并考虑好版权申明文本。
- 考虑如何接收每个富翁提出自己的评价意见。
规则方面：
- 凡是投稿者，都能得到全部参赛作品以及富翁评价的完整拷贝。
- 每个富翁都能参与对作品的评价、意见由评委会汇总、排名由评委会投票产生、全程公布。
您看如何？
现在，我向大家介绍一下 aimingoo 主席。他是1998年9月加入的大富翁论坛的，是最早的
大虾之一。当时取名 aiming，后改名为 aimingoo。本论坛第一个问题，即是由他回答完
成的。大家可以看 ID 最小的这个问题：http://www.delphibbs.com/delphibbs/dispq.asp?LID=20
一直以来，他非常关心大富翁论坛，帮助过不少人，我们的离线阅读数据库中都有记载。
我就不一一复述，打大家看离线阅读数据库吧。是非公道，自在人心。
目前他通过我们论坛正在和 Borland 联系，提供 Delphi 的 Bug 信息。当然不是一般人
碰到一点疑问就随便大叫 Bug 的那种，而是非常精准指出问题的核心，并且已经得到了
Borland 的认可。http://www.delphibbs.com/delphibbs/dispq.asp?LID=648516
我代表大富翁论坛和全体用户，向 aimingoo 能出面组织这次活动表示感谢！
同时，希望更多的富翁参与，高手低手不论，大家都可以投稿、都可以评价每件作品。
不要怕您的作品不完善，大家不会笑话您。只要您投稿，各路富翁、评委以及我们的
aimingoo 主席就有义务为您诊断把脉，提出评价和建议。这可是一次免费的接受专业
人士传教的[blue]特好机会[/blue]啊。
[red]最后 预祝这次活动成功！[/red]

这个活动没什么创意，国外早就搞过很多次了！
前几年有一届，第一名是用C语言写的动画影像效果！
如果要比水平，看来非得从图象特效入手！

学习

学习
另外,分留着也是留着
我出1500分来赞助各位参加竞赛的富翁吧[]

gz

同意yysun的提议！我支持！
我想，如果能单独开个可以上传的地方就更好了！
每个上传的程序最好能分类、写好说明文档、运行参数（那些同时对速度有要求程序，要
著明在什么配制上，运行的速度如何）、编译和运行条件等！方便大家快速看明白和运行
你的程序，提高大家的效率！
同时，没时间编程或有好想法的人，可以在论坛上发表一下自己认为好的选题，让大家在
开始做的时候，有更多的可选题和范围，也能开拓大家使用Delphi的视野！

我非常赞成以目标文件的大小来作为限制，但条件是：
1、必须有源程序，以源程序编译后的大小作为评判标准。直接提交编译过的可执行文件无
效。
2、编译时不采用Build with run-time library或run-time packages。
但这样一来大概就没人用VCL了，都用API了，如果不用VCL，怎么能体现Delphi的精华呢，
大家有没有好建议？

我说的不是：不是VCL就不能用Delphi做出精彩的程序，而是说VCL是Delphi的OOP精华所在，
是Delphi技术的重要组成部分之一。希望不要有人拿我前面的话钻牛角尖。[]

[8D][^][?][][8D][][!]

吐血支持!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

能不能组织一个控件编程比赛，
可以调查当前程序员最需要的控件，以此为题目。
控件只能从VCL和一些基本类继承，不可以只修改第三方
然后将作品交给程序员们使用，
用户投票+专家点评方式得出结果
然后给全部程序员免费使用，
并定期在大站上发布比赛公告。
如何！
这样即可用API技术，也可体现OOP
真正的delphi精髓

[red]公开征集意见：[/red]
我觉得512字节太少，这样的限制很有些束缚大家的思想，我想将字节数增加到4*1024字
节。这样，就算是写一个控件，都没有问题了。而且，也可以使用比较完整的变量名等等。
大家认为如何？
当然，最终计算字节数的规则并不改变。

太好了，能免费得到多多的好东！
非常感谢！！[]