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

2010 三月 6

tags: Borland Delphi, 微软

by Luin

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

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

这个故事的结局是我们可以开发一个能找出电脑中所有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&lt;&gt; nil) do
    begin
        tmpStr:=StrPas(curDir)+'\*.*';
        found:=FindFirst(tmpStr,faAnyFile,searchRec);
        while found=0 do
        begin
            if (searchRec.Attr and faDirectory)&lt;&gt;0 then
            begin
                if (searchRec.Name &lt;&gt; '.') and (searchRec.Name &lt;&gt; '..') 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 &gt; 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&lt;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) &lt; 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大牛讲到一个类似的例子：如何找出电影的高潮部分呢？答案：用程序找出电影音量最大的部分就行了。——很简单，当然这个比较和谐。

A long river

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

相关日志

Leave a Reply

获得更新

作品

最近评论

分类目录

Friends

Works