来，做个驴坝！用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大牛讲到一个类似的例子：如何找出电影的高潮部分呢？答案：用程序找出电影音量最大的部分就行了。——很简单，当然这个比较和谐。

这几天的生活

Luin — Wed, 16 Dec 2009 13:33:59 +0000

最近一直很忙，不过现在突然轻松了些，也许是因为明天可爱的工程实习结课的缘故吧~

他们在摆pose

鸟巢依旧好玩，不过上次是和爸妈去的，想想快回家了。

灯

没拍到...

工程实习~还是挺好玩的…

被我拆了的自行车

插了好几个小时，能不纠结点吗

没气啦

“朝花夕拾”活动，懒得拍照了…

大学第一个证书

小黄和小白~~~其它宿舍寄养的，被弄到自己宿舍啦

小黄

好可爱的小白

生活在徜徉…徜徉？

Luin — Fri, 25 Sep 2009 14:56:00 +0000

徜徉什么…

加入了院学生会宣传部。不知道忙不忙，怎样忙，院学生会转系->退出…

然后一直在晨训。就是简单的稍息立正跨步齐步走什么的，挺没意思。

其它的就是计算机导论课的作业。目前准备弄个多点触控，正在设计中~

10.1快到了，9月30日晚上我就会回到天津啦。

@MS

微软亚洲研究院

Luin's Blog » 微软

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

这几天的生活

生活在徜徉…徜徉？