Luin's Blog » Borland Delphi

来，做个驴坝！用Delphi开发A片扫描器

Luin — Sat, 06 Mar 2010 13:25:00 +0000

其实驴坝这个东西是挺好玩的，对被监控有爱的同学可以下来尝试一下。

这里，来讲一个用小创意干大事（俗称小炮打恐龙）的故事。

这个故事的结局是我们可以开发一个能找出电脑中所有A片的程序，这是个集合了影像分析、画面色块分层、人工智能等复杂算法的复杂的玩意。

A片扫描器

好吧，其实这个程序只是简单读了下文件头而已(喂喂，那位拿板砖的同学请把板砖放下)。

我们假设一般人会把A片的扩展名改掉(例如改成txt、bmp等格式。曾经的realplayer年代有人会把rmvb格式的A片改成avi格式，现在由于暴风射手之流的出现导致这种方法不灵了)，于是我们只有扫描一下文件的头部数据判断这个文件是不是一个影像文件，然后再判断这个文件的扩展名是不是一个影像文件的扩展名，如果不是自然就很可能是A片了(如果是的话应该就是阿凡达这类的电影了，你总不能说人家是A片吧)。

先送上队列遍历文件的代码(递归算法在这里更容易理解，但实际上很容易超栈溢出):

function EnumFileInQueue(path:PChar):Longint;stdcall;
var
    searchRec:TSearchRec;
    found:Integer;
    tmpStr:String;
    curDir:PChar;
    dirs:TQueue;
begin
    Result:=0;//查找结果(文件数)
    dirs:=TQueue.Create;//创建目录队列
    dirs.Push(path);//将起始搜索路径入队
    curDir:=dirs.Pop;//出队
    while (curDir<;>; nil) do
    begin
        tmpStr:=StrPas(curDir)+'\*.*';
        found:=FindFirst(tmpStr,faAnyFile,searchRec);
        while found=0 do
        begin
            if (searchRec.Attr and faDirectory)<;>;0 then
            begin
                if (searchRec.Name <;>; '.') and (searchRec.Name <;>; '..') then
                begin
                    tmpStr:=StrPas(curDir)+'\'+searchRec.Name;
                    dirs.Push(StrNew(PChar(tmpStr)));
                end;
            end
            //如果找到的是个文件
            else begin
                Result:=Result+1;
                //form1.Label2.Caption  := StrPas(curDir)+'\';
                //form1.Label1.Caption :=(StrPas(curDir)+'\'+searchRec.Name);
                if isA(StrPas(curDir)+'\'+searchRec.Name) then
                begin
                  Form1.Memo1.Lines.Add(StrPas(curDir)+'\'+searchRec.Name);
                  //form1.Button2.Click;
                end;
 
            end;
            found:=FindNext(searchRec);
        end;
        if dirs.Count >; 0 then
            curDir:=dirs.Pop
        else
            curDir:=nil;
    end;
    dirs.Free;
    FindClose(searchRec);
end;

然后是获得文件头部信息的代码：

Function GetFileBegin(const Filename: String): String;
Var
  i: integer;
  Source: tfilestream;
  s2, s3, s, s4, s5: String;
  Buf: Array[0..MaxBuf-1] Of byte;
Begin
  result:='';
  Try
    Source:=tfilestream.Create(Filename, fmOpenRead Or fmShareDenyNone);
    If Source.Size<;10 Then Exit;
    Source.Seek(0, sofrombeginning);
    Try
      Source.Read(Buf, SizeOf(Buf));
      For i:=0 To MaxBuf-1 Do
        s:=s+IntToHex(Buf[i], 2);
 
      Source.Read(Buf, SizeOf(Buf));
      For i:=0 To MaxBuf-1 Do
        s2:=s2+IntToHex(Buf[i], 2);
 
      Source.Read(Buf, SizeOf(Buf));
      For i:=0 To MaxBuf-1 Do
        s3:=s3+IntToStr(Buf[i]);
 
      Source.Read(Buf, SizeOf(Buf));
      For i:=0 To MaxBuf-1 Do
        s4:=s4+IntToStr(Buf[i]);
 
      Source.Read(Buf, SizeOf(Buf));
      For i:=0 To MaxBuf-1 Do
        s5:=s5+IntToStr(Buf[i]);
      s:=s+s2+s3+s4+s5;
      result:=s;
    Finally
      Source.Free;
    End;
  Except
    result:='';
  End;
End;

当用这个函数检测文件时，返回一个由字母和数字组成的字符串，代表着文件头信息。

接下来是判断是否是A片的函数(isA,嗯，好名字):

function isA(const FileName: String): boolean;
var
  sbegin,stmp : string;
begin
  Result := false;
  stmp :=ExtractFileExt(FileName);
  if((stmp='.rm')or(stmp='.rmvb')or(stmp='.mpq')or(stmp='.avi')or(stmp='.rm')or(stmp='.mpg')) then exit(false);
  if(GetFileSize(FileName) <; 10242880) then exit(false);
  sbegin := GetFileBegin(FileName);
  if((pos('52494646', sbegin)=1) or
     (pos('2E524D', sbegin)=1)
  )
  then exit(true);
end;

GetFileSize是我自己写的函数，可以获得文件大小，如果文件小于10242880字节就跳过检测(小于10MB的A片？)。

52494646和2E524D是rmvb和avi的头部信息，是使用上面的GetFileBegin函数算出来的，可以根据需要自己添加。

好了，一切已经完成。把程序编译出来拷到U盘里给朋友的电脑扫描一下吧(被拍不要找我…)。真简单，但真不和谐。

爱偷懒的同学猛击这里下载完整源代码和程序文件AScan

前些日子在微软技术部例会上听cxc大牛讲到一个类似的例子：如何找出电影的高潮部分呢？答案：用程序找出电影音量最大的部分就行了。——很简单，当然这个比较和谐。

做了一个有AI的五子棋

Luin — Sun, 04 Oct 2009 13:52:33 +0000

闲着没事弄了个五子棋程序，还是用delphi开发的。人工智能只用了1个小时做的，所以比较那啥~

五子棋

~~下载地址：Five2.zip~~(内容已更新，请到文章末尾重新下载)
右边的调试台是输出电脑的思维的。
现在的AI还没有优化，优化后的落子速度将是瞬时的。

制作步骤(delphi2009)
一、素材
素材包括棋盘和棋子，棋盘可以在网上找也可以自己画-_-!,我直接用的网上的素材。棋子是我自己画的，类似下面设置混合效果即可：

棋子的画法

二、代码
全局用Timer控件控制电脑下棋：

Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  ix, iy: integer;
Begin
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
  If FullMap Then
  Begin
    Flag2;
    Exit;
  End;
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
  Timer2.Enabled:=true;
End;
 
Procedure TForm1.Timer2Timer(Sender: TObject);
Begin
  Timer1.Enabled:=NowCom;
End;

主程序如下：

Type
  TForm1=Class(TForm)
    Image2: TImage;
    Pnl: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure FormCreate(Sender: TObject);
    Procedure N1Click(Sender: TObject);
    Procedure N2Click(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
    Procedure Timer2Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  Private
    { Private declarations }
    NowBlack: boolean; //当前该白棋走
    NowCom: boolean; //当前该电脑走
    //人执黑棋： not(NowBlack xor NowCom)
    BFlag: byte; //棋局标志，0：尚未开始,1：第一阶段，2：第二阶段
    BComWin: boolean; //电脑赢(第一阶段末)
    Procedure Init; //初始化(地图等)
    Function WinCount: Integer; //如果是正数则是电脑赢
    Function FullMap: boolean; //棋盘已经满了
    Function IsEmpty(X, Y: byte): boolean; //判断当前位置是否有棋子
    Function IsWin(X, Y: byte): boolean; //判断当前位置是否有棋子
    Procedure AddButton(X, Y: byte; BButton: boolean{True:Black}); //放棋子
    Procedure DelButton(X, Y: byte); //移除棋子
    Procedure PressXY(X, Y: integer); //判断X,Y属于棋盘的哪个点
    Procedure Flag2; //进入阶段2
  Public
    { Public declarations }
  End;
 
Var
  Form1: TForm1;
  Map: Array[0..14, 0..14] Of byte;//棋盘：0:白，1：黑, 2:空
Implementation
Uses AI, mmsystem;
Var
  QiZi: TImage;
  SMulu: String;
{$R *.dfm}
  { TForm1 }
Procedure TForm1.AddButton(X, Y: byte; BButton: boolean);
Begin
  QiZi:=TImage.Create(Pnl);
  With QiZi Do
  Begin
    Name:='Img_Btn_'+IntToStr(X)+'_'+IntToStr(Y);
    Parent:=Pnl;
    Cursor:=crDefault;
    Left:=5+35*X;
    top:=5+35*Y;
    Transparent:=True;
    AutoSize:=True;
    If BButton Then
      Picture.LoadFromFile(SMulu+'pic\black.bmp')
    Else
      Picture.LoadFromFile(SMulu+'pic\white.bmp')
  End;
  Map[X, Y]:=Integer(BButton); //修改地图文件
  NowBlack:=Not NowBlack; //修改该黑或白的标志
  NowCom:=Not NowCom; //修改该谁走棋的标志
  If FileExists(SMulu+'res\at.wav') Then //播放走棋的声音
    PlaySound(pchar(SMulu+'res\at.wav'), 0, snd_Async);
  if IsWin(X,Y) then showmessage('Win');
 
End;
 
Procedure TForm1.DelButton(X, Y: byte);
Var
  ic: tComponent;
Begin
  ic:=Pnl.FindComponent('Img_Btn_'+IntToStr(X)+'_'+IntToStr(Y));
  If ic<;>;Nil Then
  Begin
    ic.Free;
    Map[X, Y]:=2;
  End;
End;
 
Procedure TForm1.PressXY(X, Y: integer);
Var
  ix, iy, i: byte;
  j:integer;
Begin
  ix:=15;
  iy:=15;
  j:=0;
  For i:=0 To 14 Do
  Begin
    If (X>;(5 + j))And(X<;(40 + j)) Then
      ix:=i;
    If (Y>;(5 + j))And(Y<;(40 + j)) Then
      iy:=i;
    if (ix<;>;15)and(iy<;>;15) then break;
    inc(j,35);
  End;
  If (ix = 15)Or(iy = 15) Then Exit;
  If not IsEmpty(ix,iy) Then
  begin
    beep;//TODO:不能走棋
    exit;
  end;
 
  AddButton(ix, iy, NowBlack);
End;
Procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
Begin
  If (BFlag=1)And(Not(NowCom)) Then
    PressXY(X, Y);
End;
 
procedure TForm1.Init;
var
  i: Integer;
  j: Integer;
begin
  for i := 0 to 14 do
    for j := 0 to 14 do
      Map[i][j] := 2;
end;
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
  SMulu:=ExtractFilePath(Application.ExeName);
  BFlag:=0; //比赛未开始；
  Init;
  BFlag:=1;
  NowBlack:=True;
  NowCom:=True;
End;
 
Function TForm1.IsEmpty(X, Y: byte): boolean;
Begin
  result:= (Map[X, Y] = 2);
End;
 
function TForm1.IsWin(X, Y: byte): boolean;
var CurrentChessman,i,j,n:byte;
begin
  result:=false;
  CurrentChessman := Map[X][Y];
  //横向
  n:=1;
  i:=X-1;
  while(i>;=0)and(Map[i][Y]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
  end;
  i:=X+1;
  while(i<;=15)and(Map[i][Y]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
  end;
  if n>;=5 then exit(true);
  //纵向
  n:=1;
  j:=Y-1;
  while(j>;=0)and(Map[X][j]=CurrentChessman) do
  begin
    inc(n);
    dec(j);
  end;
  j:=Y+1;
  while(j<;=15)and(Map[X][j]=CurrentChessman) do
  begin
    inc(n);
    inc(j);
  end;
  if n>;=5 then exit(true);
  //正斜向
  n:=1;
  i:=X-1;
  j:=Y-1;
  while(i>;=0)and(j>;=0)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
    dec(j);
  end;
  i:=X+1;
  j:=Y+1;
  while(i<;=15)and(j<;=15)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
    inc(j);
  end;
  if n>;=5 then exit(true);
  //反斜向
  n:=1;
  i:=X-1;
  j:=Y+1;
  while(i>;=0)and(j<;=15)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    dec(i);
    inc(j);
  end;
  i:=X+1;
  j:=Y-1;
  while(i<;=15)and(j>;=0)and(Map[i][j]=CurrentChessman) do
  begin
    inc(n);
    inc(i);
    dec(j);
  end;
  if n>;=5 then exit(true);
end;
 
Procedure TForm1.N1Click(Sender: TObject);
Begin
  BFlag:=1;
  NowBlack:=True;
  NowCom:=False;
End;
 
Procedure TForm1.N2Click(Sender: TObject);
Begin
  BFlag:=1;
  NowBlack:=True;
  NowCom:=True;
End;
 
Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  ix, iy: integer;
Begin
  Timer1.Enabled:=False;
  Timer2.Enabled:=False;
  If FullMap Then
  Begin
    Flag2;
    Exit;
  End;
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
  Timer2.Enabled:=true;
End;
 
Procedure TForm1.Timer2Timer(Sender: TObject);
Begin
  Timer1.Enabled:=NowCom;
End;
 
Function TForm1.FullMap: boolean;
Var
  X, Y: byte;
Begin
  result:=True;
  For X:=0 To 14 Do
    For Y:=0 To 14 Do
      If Map[X, Y]=2 Then
      Begin
        result:=False;
        Exit;
      End;
End;
 
Procedure TForm1.Flag2;
Begin
  BFlag:=2;
  //TODO:计算被罚数目
  //提示用户
End;
 
Function TForm1.WinCount: Integer;
Begin
End;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WinCount));
end;
 
procedure TForm1.Button2Click(Sender: TObject);
 var ix, iy: integer;
begin
  if not GetComXY(True,ix,iy) then ;
  AddButton(ix, iy, NowBlack);
end;

三、AI
AI总得来说很简单，只有假设棋子已经落下，然后搜索计算得分即可
当然这个AI相当简单，输的几率也很大，但是基本思想即是如此。更多可以参考更加强大的AI算法~
10月7日更新
主要重写了AI，代码如下：

Unit AI;
 
Interface
{
0
1单1
2双1
3单2
4双2
5单3
6双3
7单4
8双4
9单5
10双5
 
}
type
  TAi = class
    //AI是否扮演黑棋
    isBlack:Boolean;
  Private
    //是否在计算自己的得分
    bSelf : Boolean;
    //当前正在计算的位置
    curX,curY:Byte;
    //当前相同的棋子数
    TongNum:Integer;
    //当前棋子左右空余数目
    nLeft,nRight:byte;
    //初始化计算，数值清空
    procedure initCul;
    //判断横向
    function CM2H : integer;
    function CM2H_info : integer;
    //判断纵向
    function CM2V : integer;
    function CM2V_info : integer;
    //判断正斜向
    function CM2X : integer;
    function CM2X_info : integer;
    //判断反斜向
    function CM2X2 : integer;
    function CM2X2_info : integer;
    //分析类型
    Function N2ChessType(n:byte): Byte;
    //获得评分
    function GetMark(chessType:Byte):integer;
  Public
    //下棋，返回false表明无法选择位置
    function Play(var toX,toY:Byte): Boolean;
end;
 
 
 
Implementation
Uses Windows,SysUtils,Main;
 
{ TAi }
 
function TAi.CM2H: integer;
var i:integer;
begin
  result:=1;
  i:=curX-1;
  while(i>=0)and(Map[i][curY]=Map[curX][curY]) do
  begin
    inc(result);
    dec(i);
  end;
  i:=curX+1;
  while(i<=14)and(Map[i][curY]=Map[curX][curY]) do
  begin
    inc(result);
    inc(i);
  end;
end;
 
function TAi.CM2H_info: integer;
var i:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  while(i>=0)and((Map[i][curY]=Map[curX][curY])or(Map[i][curY]=2)) do
  begin
    if Map[i][curY]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    dec(i);
  end;
  //第二轮
  i:=curX+1;
  while(i<=14)and((Map[i][curY]=Map[curX][curY])or(Map[i][curY]=2)) do
  begin
    if Map[i][curY]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    inc(i);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2H;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2V: integer;
var j:integer;
begin
  result:=1;
  j:=curY-1;
  while(j>=0)and(Map[curX][j]=Map[curX][curY]) do
  begin
    inc(result);
    dec(j);
  end;
  j:=curY+1;
  while(j<=14)and(Map[curX][j]=Map[curX][curY]) do
  begin
    inc(result);
    inc(j);
  end;
end;
 
function TAi.CM2V_info: integer;
var j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  j:=curY-1;
  while(j>=0)and((Map[curX][j]=Map[curX][curY])or(Map[curX][j]=2)) do
  begin
    if Map[curX][j]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    dec(j);
  end;
  //第二轮
  j:=curY+1;
  while(j<=14)and((Map[curX][j]=Map[curX][curY])or(Map[curX][j]=2)) do
  begin
    if Map[curX][j]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    inc(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2V;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2X: integer;
var i,j:integer;
begin
  result:=1;
  i:=curX-1;
  j:=curY-1;
  while(i>=0)and(j>=0)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Dec(i);
    Dec(j);
  end;
  i:=curX+1;
  j:=curY+1;
  while(i<=14)and(j<=14)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Inc(i);
    Inc(j);
  end;
end;
 
function TAi.CM2X2: integer;
var i,j:integer;
begin
  result:=1;
  i:=curX-1;
  j:=curY+1;
  while(i>=0)and(j<=14)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Dec(i);
    Inc(j);
  end;
  i:=curX+1;
  j:=curY-1;
  while(i<=14)and(j>=0)and(Map[i][j]=Map[curX][curY]) do
  begin
    Inc(result);
    Inc(i);
    Dec(j);
  end;
end;
 
function TAi.CM2X2_info: integer;
var i,j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  j:=curY+1;
  while(i>=0)and(j<=14)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    Inc(nLeft);
    Dec(i);
    Inc(j);
  end;
  //第二轮
  i:=curX+1;
  j:=curY-1;
  while(i<=14)and(j>=0)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    Inc(nRight);
    Inc(i);
    Dec(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2X2;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.CM2X_info: integer;
var i,j:Integer; n:Byte;
begin
  initCul;
  //第一轮
  i:=curX-1;
  j:=curY-1;
  while(i>=0)and(j>=0)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    inc(nLeft);
    Dec(i);
    dec(j);
  end;
  //第二轮
  i:=curX+1;
  j:=curY+1;
  while(i<=14)and(j<=14)and((Map[i][j]=Map[curX][curY])or(Map[i][j]=2)) do
  begin
    if Map[i][j]=Map[curX][curY] then inc(TongNum);
    inc(nRight);
    Inc(i);
    inc(j);
  end;
 
  if nLeft+nRight<4 then Exit(0);
 
  //分析
  n:=CM2X;
  dec(TongNum,n-1);
  result:=N2ChessType(n);
end;
 
function TAi.GetMark(chessType: Byte): integer;
begin
  case chessType of
  0:Exit(0);
  1:Exit(0);
  2:Exit(5);
  3:Exit(11);
  4:Exit(31);
  5:Exit(21);
  6:Exit(910);
  7:Exit(41);
  8:Exit(11000);
  9:Exit(110000);
  10:Exit(110000);
  13:Exit(0);
  14:Exit(5);
  15:Exit(10);
  16:Exit(30);
  17:Exit(20);
  18:Exit(900);
  19:Exit(40);
  20:Exit(10000);
  21:Exit(100000);
  22:Exit(100000);
  end;
end;
 
procedure TAi.initCul;
begin
  TongNum:=0;
  nLeft:=0;
  nRight:=0;
end;
 
function TAi.N2ChessType(n:Byte): Byte;
var bsc,h:Byte;
begin
  h:=0;
  if nLeft>0 then Inc(h);
  if nRight>0 then Inc(h);
  if bSelf then bsc:=0 else bsc:=12;
 
  if h = 0 then Exit(0);
  case n of
    1:
    begin
      if h=1 then Exit(bsc+1)
      else Exit(bsc+2);
    end;
    2:
    begin
      if h=1 then Exit(bsc+3)
      else Exit(bsc+4);
    end;
    3:
    begin
      if h=1 then Exit(bsc+5)
      else Exit(bsc+6);
    end;
    4:
    begin
      if h=1 then Exit(bsc+7)
      else Exit(bsc+8);
    end;
    else
    begin
      if h=1 then Exit(bsc+9)
      else Exit(bsc+10);
    end;
  end;
end;
 
function TAi.Play(var toX, toY: Byte): Boolean;
Var
  mark,maxMark:integer;
  i,j: integer;
  mx,my:integer;
Begin
   maxMark:=0;
   form1.Memo1.Clear;
   for i := 0 to 14 do
   begin
    for j := 0 to 14 do
    begin
      if (i=7)and(j=7) then
      TongNum:=0;
      if Map[i][j]=2 then
      begin
        curX:=i;
        curY:=j;
        mark:=0;
        Map[i][j]:=Ord(isBlack);
        bSelf:=True;
        //form1.Memo1.Lines.Add('-------------');
        //form1.Memo1.Lines.Add('loc：x:'+inttostr(i)+',y:'+inttostr(j));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2H_info));
        if TongNum>0 then
        TongNum:=0;
 
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2V_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X2_info));
        {form1.Memo1.Lines.Add('f1：'+inttostr(GetMark(CM2H_info))
          +inttostr(GetMark(CM2V_info))+inttostr(GetMark(CM2X_info))+
          inttostr(GetMark(CM2X2_info)));  }
        Map[i][j]:=Ord(not isBlack);
        bSelf:=False;
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2H_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2V_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X_info));
        Inc(mark,nLeft*nRight+1000*TongNum+10000*GetMark(CM2X2_info));
        {form1.Memo1.Lines.Add('f2：'+inttostr(GetMark(CM2H_info))
          +inttostr(GetMark(CM2V_info))+inttostr(GetMark(CM2X_info))+
          inttostr(GetMark(CM2X2_info)));  }
        Map[i][j]:=2;
        if mark>maxMark then
        begin
          maxMark:=mark;
          mx:=i;
          my:=j;
        end
        else if mark=maxMark then  form1.Memo1.Lines.Add('s');
 
      end;
    end;
   end;
   toX:=mx;
   toY:=my;
End;
 
End.

点此下载五子棋程序及源代码(Delphi 2009)

Bean For Programmer(2)一个幽默的标准转弯。

Luin — Thu, 09 Aug 2007 14:07:02 +0000

记得前些日子我说有一个Bean For Programmer计划，不知道有没有人当真。现在这个计划已经有了一些小小的进展，能够读取地图了。换句话说，计划已经完成了0.01%—–很可观的数字。不过在此不着重谈这个，现在要说的是一个规则的实现方法。Bean For Programmer计划中详细地写出了规则：其中一条是：“8、主程序控制3个（或更多）棋子，并通知参赛机器人比赛开始并提供当前地图、棋子信息和位置”。问题来了，如何“向机器人提供当前地图”？或许有一种非常简单的方法：向机器人发送一个包含地图路径的信息。但是假如为了公平竞赛，不允许将地图保存在磁盘上而是单独提供一个EXE来保存地图该怎么办呢？下面我来演示一下：
1.建立一个保存地图的EXE（简称地图EXE），定义一个20*20（实际需要可能不止如此）的数组，里面包含两个值：1或0（为了以后丰富地图方便，我们把它声明为byte而不是Boolean）：

Map: Array[1..20, 1..20] Of byte;

2.运行OllyDBG并定位到保存Map值的地方。

OllyDBG定位截图

3.复制地址。

复制地址

4.机器人部分：

HANO:=FindWindow(Nil, 'Bean for programmer'); //找窗口（地图EXE标题为'Bean for programmer）
If HANO=0 Then//寻找窗体，
    Begin
      MessageBox(0, '没有找到目标程序', '我敬爱的Bean', mb_ok);
      Exit
End;
    FromH:=$00454DA0;//开始地址
    GetWindowThreadProcessId(HANO, @Dw1);
    HANS:=OpenProcess(PROCESS_VM_READ, True, Dw1); //打开进程
    For i:=1 To 400 Do
    Begin
      inc(FromH);
If ReadProcessMemory(HANS, pointer(FromH-1), lpBuffer, 1, lpNumberOfBytesRead)      Then//对地图EXE的内存数据
s:=s+IntToStr(lpBuffer^);//这样我们就获得了包含地图EXE中Map数组的值。
    End;

5．根据s画出地图。下面我截取了地图EXE和机器人端画出的地图。
（1）机器人端

机器人端截图

（2）地图EXE端

地图EXE端截图

我们可以发现两幅地图完全一样，OK，大功告成。