unifunc.pas

查询邮政区号、身份证号、手机号的归属地

function WinExecAndWait32(FileName,Options:String;Visibility:integer):Integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  CMD,WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
  dwdResult:DWord;
begin
  WorkDir:=ExtractFilePath(FileName); // 取被运行程序的目录
  //GetDir(0,WorkDir); // 取当前目录
  StrPCopy(zCurDir,WorkDir);
  CMD:=Trim(FileName+' '+Options);
  StrPCopy(zAppName,CMD);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb:=Sizeof(StartupInfo);
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow:=Visibility;
  if CreateProcess(nil,
                   zAppName,              // pointer to command line string
                   nil,                   // pointer to process security attributes
                   nil,                   // pointer to thread security attributes
                   false,                 // handle inheritance flag
                   CREATE_NEW_CONSOLE or  // creation flags
                   NORMAL_PRIORITY_CLASS,
                   nil,                   // pointer to new environment block
                   zCurDir,               // pointer to current directory name
                   StartupInfo,           // pointer to STARTUPINFO
                   ProcessInfo) then      // pointer to PROCESS_INF
  begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,dwdResult);
    Result:=dwdResult;
  end
  else
  begin
    if WinExec(PChar(CMD),SW_SHOWNORMAL)>0 then
      Result:=0 //运行成功
    else
      Result:=-1; //运行失败
  end;
end;

function BrowseFolder(Title:String;OwnerHandle:THandle;var Dir:String):Boolean;
var
  Info:TBrowseInfo;
  ItemId:PItemIDList;
begin
  try
    SetLength(Dir,500);
    with Info do
    begin
      hwndOwner:=OwnerHandle;
      pidlRoot:=nil;
      //pszDisplayName:=nil;
      pszDisplayName:=PAnsiChar(Dir);
      lpszTitle:=PAnsiChar(Title);
      //ulFlags:=BIF_BROWSEFORCOMPUTER;  { 浏览计算机 }
      //ulFlags:=BIF_BROWSEFORPRINTER;   { 浏览打印机?? }
      //ulFlags:=BIF_DONTGOBELOWDOMAIN;  { 到NT域?? }
      //ulFlags:=BIF_RETURNFSANCESTORS;  { ?? }
      //ulFlags:=BIF_STATUSTEXT;         { ?? }
      ulFlags:=BIF_RETURNONLYFSDIRS; { 返回FSDirs?? 浏览文件夹 }
      //ulFlags:=0;                      { 浏览文件夹 }
      lpfn:=nil;
      lParam:=0;
      iImage:=0;
    end;
    ItemId:=SHBrowseForFolder(Info);
    if SHGetPathFromIDList(ItemId,PChar(Dir)) then
    begin
      SetLength(Dir,StrLen(PChar(Dir)));
      Dir:=Trim(Dir);
      Result:=True;
    end
    else Result:=False;
  except
    Result:=False;
  end;
end;

function FindFiles(const Path,Mask:String;var FileList:TStrings;
  const SubFolder,SubFolderMax:Word; //只搜索SubFolder指定级数子目录，如果SubFolder>=SubFolderMax则搜索所有子目录
  var bSearchStop:Boolean; //允许父过程重置其值为True而中止搜索
  Handle:THandle=0):Integer; //Handle为0则找到的文件添加到FileList，否则通过WM_CopyData消息发给Handle
var // 按 SubFolder 指定的级数搜索子目录(Path：待搜索的文件夹；Mask：指定搜索的文件类型)
  MainCount,SubCount:Integer;
  MainPath: String;
  SourceSel:TStrings;
procedure SearchFiles(const sPath,sMask:String;var FileList:TStrings);
var
  SRec:TSearchRec;
  TheDirectory:String;
  Retval:Integer;
  SubSel:TStrings;
  FileName:String;
  WMCopyData:TCopyDataStruct;
begin
  TheDirectory:=Trim(sPath);
  SubSel:=TStringList.Create;
  try
    while RightStr(TheDirectory,1)='\' do
      TheDirectory:=Copy(TheDirectory,1,Length(TheDirectory)-1); //去掉尾部"\"
    PosEx('\',TheDirectory,SubSel); // 统计子目录级数
    SubCount:=SubSel.Count;
    TheDirectory:=TheDirectory+'\';
  finally
    SubSel.Free;
  end;
  //查找文件
  Retval:=FindFirst(TheDirectory+sMask,faAnyFile,SRec);
  try
    while Retval=0 do //找到文件或目录
    begin
      if bSearchStop then exit;
      Application.ProcessMessages;
      if (SRec.Attr and faDirectory)=0 then  //找到文件
      begin
        if (SRec.Name<>'.') and (SRec.Name<>'..') then
        begin
          FileName:=TheDirectory+SRec.Name;
          if Handle>0 then
          begin
            WMCopyData.cbData:=Length(FileName)+1;
            GetMem(WMCopyData.lpData,WMCopyData.cbData ); //为传递的数据区分配内存
            try
              StrCopy(WMCopyData.lpData,Pchar(FileName));
              SendMessage(Handle,WM_COPYDATA,0,Cardinal(@WMCopyData)); // 发送WM_COPYDATA消息
            finally
              FreeMem(WMCopyData.lpData); //释放资源
            end;
          end
          else FileList.Add(FileName); // 添加文件
        end;
      end;
      Retval:=FindNext(SRec);
    end;
  finally
    //FindClose(SRec.FindHandle);
    FindClose(SRec);
  end;
  //查找子目录
  if (SubFolder>=SubFolderMax) or //搜索所有子目录
     ((SubCount-MainCount)<SubFolder) then //只搜索指定级数的目录
  begin
    Retval:=FindFirst(TheDirectory+'*.*',faDirectory,SRec);
    try
      while Retval=0 do //找到文件或目录
      begin
        if bSearchStop then exit;
        Application.ProcessMessages;
        if ((SRec.Attr and faDirectory)<>0) then // 这是个目录
        begin
          if (SRec.Name<>'.') and (SRec.Name<>'..') then
          begin
            SearchFiles(TheDirectory+SRec.Name,sMask,FileList);
          end;
        end;
        Retval:=FindNext(SRec);
      end;
    finally
      //FindClose(SRec.FindHandle);
      FindClose(SRec);
    end;
  end;
end;
begin
  try
    MainPath:=Trim(Path);
    While RightStr(MainPath,1)='\' do
      MainPath:=Copy(MainPath,1,Length(MainPath)-1);
    if DirectoryExists(MainPath) then
    begin
      SourceSel:=TStringList.Create;
      try
        PosEx('\',MainPath,SourceSel);
        MainCount:=SourceSel.Count;
      finally
        SourceSel.Free;
      end;
      SearchFiles(MainPath,Iif(Mask='','*.*',Mask),FileList); // 搜索文件
    end;
    if (Handle>0) then //如果实时用消息发回文件名，本函数返回接收窗口句柄
      Result:=Handle
    else //否则返回本次搜索到的文件总数
      Result:=FileList.Count;
  except
    Result:=-1;
  end;
end;

function ParsePath(const AppPath,Path:String):String;
var
  Folder,sPath:String;
  tmp:array[0..Max_Path] of Char;
  iCount:Integer;
begin
  Result:='';
  Folder:=Trim(AppPath);
  sPath:=LowerCase(Trim(Path));
  while RightStr(Folder,1)='\' do
    Folder:=Copy(Folder,1,Length(Folder)-1);
  Folder:=Folder+'\';
  if (sPath='sys') or (sPath='system') then //系统目录
  begin
    iCount:=GetSystemDirectory(tmp,Max_Path);
    Folder:=Copy(tmp,1,iCount);
    while RightStr(Folder,1)='\' do
      Folder:=Copy(Folder,1,Length(Folder)-1);
    Result:=Folder+'\';
  end
  else if (sPath='lan') or (sPath='language') then //语言包目录
    Result:=Folder+'Language\'
  else //if (sPath='') or (sPath='app') or (sPath='application') then //程序目录
    Result:=Folder;
end;

function GetType(const FileName:String):Integer;
var
  ExtName:String;
begin
  ExtName:=UpperCase(ExtractFileExt(Trim(FileName)));
  if (ExtName='') or (ExtName='.') then Result:=isError  // 文件名为空 }
  // Windows Media 文件|*.asf;*.wm;*.wmd;*.wmp;*.wmz;*.wpl|
  else if ExtName='.ASF'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WM'   then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WMD'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WMP'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WMZ'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WPL'  then Result:=isVideo  // 返回 Video 格式
  // Windows Media 视频文件|*.wmv|
  else if ExtName='.WMV'  then Result:=isVideo  // 返回 Video 格式
  // Windows Media 音频文件|*.wma|
  else if ExtName='.WMA'  then Result:=isWave   // 返回 Wave 格式
  // Windows Media 列表文件|*.asx;*.wax;*.wmx;*.wvx|
  else if ExtName='.ASX'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WAX'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WMX'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.WVX'  then Result:=isVideo  // 返回 Video 格式
  // Windows 视频文件|*.avi|
  else if ExtName='.AVI'  then Result:=isVideo  // 返回 Video 格式
  // Windows 音频文件|*.wav|
  else if ExtName='.WAV'  then Result:=isWave   // 返回 WAV 格式
  // MPEG 视频文件|*.dat;*.mpg;*.mpe;*.mpeg;*.m1v;*.m2v;*.mpv2;*.mp2v;*.ts;*.tp;*.tpr;*.pva;*.pss|
  else if ExtName='.DAT'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.MPG'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.MPE'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.MPEG' then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.M1V'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.M2V'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.MPV2' then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.MP2V' then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.TS'   then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.TP'   then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.TPR'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.PVA'  then Result:=isVideo  // 返回 Video 格式
  else if ExtName='.PSS'  then Result:=isVideo  // 返回 Video 格式
  // MPEG 音频文件|*.mpa;*.mp2;*.m1a;*.m2a|
  else if ExtName='.MPA'  then Result:=isMusic  // 返回 Music 格式
  else if ExtName='.MP2'  then Result:=isMusic  // 返回 Music 格式
  else if ExtName='.M1A'  then Result:=isMusic  // 返回 Music 格式
  else if ExtName='.M2A'  then Result:=isMusic  // 返回 Music 格式
  // Mp3 音频文件|*.mp3|
  else if ExtName='.MP3'  then Result:=isMp3    // 返回 MP3 格式
  else if ExtName='.MPGA' then Result:=isMp3    // 返回 MP3 格式
  // AIFF 音频文件|*.aif;*.aifc;*.aiff|
  else if ExtName='.AIF'  then Result:=isAIFF   // 返回 AIFF 格式
  else if ExtName='.AIFC' then Result:=isAIFF   // 返回 AIFF 格式
  else if ExtName='.AIFF' then Result:=isAIFF   // 返回 AIFF 格式
  // AU 音频文件|*.au;*.snd|
  else if ExtName='.AU'   then Result:=isAU     // 返回 AU 格式
  else if ExtName='.SND'  then Result:=isAU     // 返回 AU 格式
  // MIDI 文件|*.mid;*.midi;*.rim|
  else if ExtName='.MID'  then Result:=isMidi   // 返回 MIDI 格式
  else if ExtName='.MIDI' then Result:=isMidi   // 返回 MIDI 格式
  else if ExtName='.RMI'  then Result:=isMidi   // 返回 RMI 格式
  else if ExtName='.RIM'  then Result:=isMidi   // 返回 RIM 格式
  // MPEG4 视频文件|*.mp4;*.m4v;*.m4p;*.m4b|
  else if ExtName='.MP4'  then Result:=isMp4V   // 返回 MPEG4 视频格式
  else if ExtName='.M4V'  then Result:=isMp4V   // 返回 MPEG4 视频格式
  else if ExtName='.M4P'  then Result:=isMp4V   // 返回 MPEG4 视频格式
  else if ExtName='.M4B'  then Result:=isMp4V   // 返回 MPEG4 视频格式
  // MPEG4 音频文件|*.m4a;*.aac|
  else if ExtName='.M4A'  then Result:=isMp4A   // 返回 MPEG4 音频格式
  else if ExtName='.AAC'  then Result:=isMp4A   // 返回 MPEG4 音频格式
  // RealAudio 文件|*.ra|
  else if ExtName='.RA'   then Result:=isReal   // 返回 Real 格式
  // RealVideo 文件|*.rm;*.rmvb;*.ram;*.rpm|
  else if ExtName='.RM'   then Result:=isReal   // 返回 Real 格式
  else if ExtName='.RMVB' then Result:=isReal   // 返回 Real 格式
  else if ExtName='.RAM'  then Result:=isReal   // 返回 Real 格式
  else if ExtName='.RPM'  then Result:=isReal   // 返回 Real 格式
  // RealPlayer 列表文件|*.rt;*.rp;*.smi;*.smil|
  else if ExtName='.RT'   then Result:=isReal   // 返回 Real 格式
  else if ExtName='.RP'   then Result:=isReal   // 返回 Real 格式
  else if ExtName='.SMI'  then Result:=isReal   // 返回 Real 格式
  else if ExtName='.SMIL' then Result:=isReal   // 返回 Real 格式
  // DirectShow 媒体文件|*.dsm;*.dsv;*.dsa;*.dss|
  else if ExtName='.DSM'  then Result:=isDShow  // 返回 DirectShow 格式
  else if ExtName='.DSV'  then Result:=isDShow  // 返回 DirectShow 格式
  else if ExtName='.DSA'  then Result:=isDShow  // 返回 DirectShow 格式
  else if ExtName='.DSS'  then Result:=isDShow  // 返回 DirectShow 格式
  // QuickTime 文件|*.mov;*.qt;*.amr;*.3gp;*.3gpp;*.3g2;*.3gp2|
  else if ExtName='.MOV'  then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.QT'   then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.AMR'  then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.3GP'  then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.3GPP' then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.3G2'  then Result:=isQTime   // 返回 QuickTime 格式
  else if ExtName='.3GP2' then Result:=isQTime   // 返回 QuickTime 格式
  // DVD
  else if ExtName='.VOB' then Result:=isDVD      // 返回 DVD 格式
{
  // Flash 文件(swf)|*.swf;*.exe|
  else if ExtName='.SWF'  then Result:=isSwf    // 返回 Flash 格式
  else if ExtName='.EXE'  then Result:=IifInt(isFlash(FileName),isExe,isError) // 返回 EXE Flash 格式/不支持的文件格式，无返回格式
}
  // 列表文件(ini)|*.ini|
  else if ExtName='.INI'  then Result:=isIni    // 打开的是列表文件，无格式
  // 不支持的格式
  else Result:=isError;                         // 不支持的文件格式，返回错误标志
end;

{========================= 从右边开始取子字符串 ===============================}
function RightStr(Str:String;SubLen:Integer):String;
var
  Len1,Len2,Len3 :Integer;
begin
  Len1:=Length(Str);
  if (SubLen<=0) or (SubLen>=Len1) then
    Len2:=Len1
  else
    Len2:=SubLen;
  Len3:=Len1-Len2+1;
  Result:=Copy(Str,Len3,Len2);
end;

function PosEx(const SubString,Str:String;var SubIndex:TStrings):Integer;
var
  SubLength,Index:Integer;
  Sub,SouStr,tmpStr:String;
begin
  try
    Result:=0;
    Sub:=SubString;
    SouStr:=Str;
    SubLength:=Length(Sub);
    if SubLength>0 then
    begin
      for Index:=1 to SubLength do tmpStr:=tmpStr+'`'; // 生成临时替换字符串
      repeat
        Index:=Pos(Sub,SouStr);
        if Index>0 then
        begin
          SubIndex.Add(Trim(IntToStr(Index)));
          Delete(SouStr,Index,SubLength);
          Insert(tmpStr,SouStr,Index);
          Result:=Index;
        end
        else Break;
      until Index=0;
    end;
  except
    Result:=-1;
  end;
end;

function PosR(const SubString,Str:String):Integer;
var //找最后一个子串的位置
  SubLength,Index:Integer;
  Sub,SouStr,tmpStr:String;
begin
  try
    Result:=0;
    Sub:=SubString;
    SouStr:=Str;
    SubLength:=Length(Sub);