⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unifunc.pas

📁 查询邮政区号、身份证号、手机号的归属地
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
    if SubLength>0 then
    begin
      for Index:=1 to SubLength do tmpStr:=tmpStr+'`'; // 生成临时替换字符串
      repeat
        Index:=Pos(Sub,SouStr);
        if Index>0 then
        begin
          Delete(SouStr,Index,SubLength);
          Insert(tmpStr,SouStr,Index);
          Result:=Index;
        end
        else Break;
      until Index=0;
    end;
  except
    Result:=-1;
  end;
end;

//=============这个用于取代 API 的 Sleep ================
procedure TimeDelay(Interval:Cardinal=1000);
var
  timeNow:Cardinal;
begin
  timeNow:=GetTickCount(); // 取当前时间
  repeat
    Application.ProcessMessages;
  Until GetTickCount()-timeNow>=Interval;
end;

{ 从注册表中读数值 }
function ReadRegInteger(MainKey:DWORD;SubKey:String;CodeName:String):Integer;
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  { 注册表主键 }
    OpenKey(Pchar(SubKey),False);   { 打开子键 }
    try
      Result:=ReadInteger(Pchar(CodeName));
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

{ 从注册表中读字符串值 }
function ReadRegString(MainKey:DWORD;SubKey:String;CodeName:String):String;
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  { 注册表主键 }
    OpenKey(Pchar(SubKey),False);   { 打开子键 }
    try
      Result:=ReadString(Pchar(CodeName));
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

{ 把数值写入注册表 }
Procedure WriteRegInteger(MainKey:DWORD;SubKey:String;CodeName:String;CodeValue:Integer);
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  { 注册表主键 }
    OpenKey(Pchar(SubKey),True);   { 打开子键 }
    try
      WriteInteger(Pchar(CodeName),CodeValue);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

{ 把字符串值写入注册表 }
Procedure WriteRegString(MainKey:DWORD;SubKey:String;CodeName:String;CodeString:String);
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  { 注册表主键 }
    OpenKey(Pchar(SubKey),True);   { 打开子键 }
    try
      WriteString(Pchar(CodeName),CodeString);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

// 删除注册表中的字符串值
Procedure DeleteRegValue(MainKey:DWORD;SubKey:String;ValueName:String);
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  //注册表主键
    OpenKey(Pchar(SubKey),False);   //打开子键
    try
      DeleteValue(Pchar(ValueName));
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

// 删除注册表中的子键
Procedure DeleteRegSubKey(MainKey:DWORD;SubKey:String;SubName:String);
begin
  with TRegistry.Create do
  try
    RootKey:=MainKey;  //注册表主键
    OpenKey(Pchar(SubKey),False);   //打开子键
    try
      DeleteKey(Pchar(SubName));
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

{======================从INI文件中读取一个数值===========================}
function ReadIni_Int(iniFileName:String; OptionName:String;KeyName:String):Integer;
var
  FileName : String;
begin
  FileName:=Trim(iniFileName);
  with TIniFile.Create(FileName) do
  try
    Result:=ReadInteger(OptionName,KeyName,0);
  finally
    Free;
  end;
end;

{======================从INI文件中读取一个字符串===========================}
function ReadIni_Str(iniFileName:String; OptionName:String;KeyName:String):String;
var
  FileName : String;
begin
  FileName:=Trim(iniFileName);
  with TIniFile.Create(FileName) do
  try
    Result:=ReadString(OptionName,KeyName,'');
  finally
    Free;
  end;
end;

{======================写一个数值到INI文件中===========================}
procedure WriteIni_Int(iniFileName:String; OptionName:String;KeyName:String;KeyCode:Integer);
var
  FileName : String;
begin
  FileName:=Trim(iniFileName);
  with TIniFile.Create(FileName) do
  try
    WriteInteger(OptionName,KeyName,KeyCode);
  finally
    Free;
  end;
end;

{======================写一个字符串到INI文件中===========================}
procedure WriteIni_Str(iniFileName:String; OptionName:String;KeyName:String;KeyCode:String);
var
  FileName : String;
begin
  FileName:=Trim(iniFileName);
  with TIniFile.Create(FileName) do
  try
    WriteString(OptionName,KeyName,KeyCode);
  finally
    Free;
  end;
end;

{ 分解目录 }
function ExtractFolder(const strPath:String;var Folders:TStrings):Integer;
var
  Index:Integer;
  SouStr,tmpStr:String;
begin
  try
    if FileExists(strPath) then
      SouStr:=ExtractFilePath(strPath)
    else
      SouStr:=strPath;
    SouStr:=SouStr+Iif(RightStr(SouStr,1)='\','','\'); // 在目录后面加上"\"
    repeat
      Index:=Pos('\',SouStr);
      Case Index of
      0 : Break; // 没找到
      1 : Delete(SouStr,1,Index); // 忽略开头的"\"
      else
        begin
          tmpStr:=Copy(SouStr,1,Index-1);
          Folders.Add(tmpStr);
          Delete(SouStr,1,Index);
        end;
      end;
    until Index=0;
    Result:=Folders.Count;
  except
    Result:=-1; // 出错了
  end;
end;

function MkDirEx(PathName:String):Boolean;
var
  DcSou:TStrings;
  DcPath:String;
  Index:Integer;
  TmpStr:String;
begin  // C:\Windows\System32\Macromed\Flash
  DcPath:=Trim(PathName);
  while RightStr(DcPath,1)='\' do
    DcPath:=Copy(DcPath,1,Length(DcPath)-1);
  if DirectoryExists(DcPath) then Result:=True
  else if Length(DcPath)<3 then Result:=False
  else
  begin
    DcSou:=TStringList.Create;
    try
      ExtractFolder(DcPath,DcSou);
      if DcSou.Count>=1 then
      begin
        TmpStr:=DcSou.Strings[0];
        for Index:=1 to DcSou.Count-1 do
        begin
          TmpStr:=TmpStr+'\'+DcSou.Strings[Index];
          if not DirectoryExists(TmpStr) then
          if CreateDir(TmpStr)=False then Break;
        end;
      end;
    finally
      DcSou.Free;
    end;
    Result:=DirectoryExists(DcPath);
  end;
end;

function RepairURL(const URL:String):String;
var
  sURL,tmpStr:String;
  iIndex:Integer;
begin //把 + 号改成 - 号
  sURL:=Trim(URL);
  if sURL<>'' then
  begin
    iIndex:=Pos('?-',sURL);
    if not (iIndex>0) then
    begin
      iIndex:=Pos('?+',sURL);
      if (iIndex>0) then
      begin
        tmpStr:=Copy(sURL,1,iIndex)+'-';
        Delete(sURL,1,iIndex+1);
        sURL:=tmpStr+sURL;
      end
      else
      begin
        iIndex:=Pos('?',sURL);
        if (iIndex>0) then
        begin
          tmpStr:=Copy(sURL,1,iIndex)+'-';
          Delete(sURL,1,iIndex);
          sURL:=tmpStr+sURL;
        end;
      end;
    end;
  end;
  Result:=sURL;
end;

function SimURL(const URL:String):String;
var //去掉链接头部
  MediaURL,tmpStr:String;
  iIndex:Integer;
begin
  MediaURL:=Trim(URL);
  if (Copy(MediaURL,2,2)=':\') then //判断是否本地媒体文件
  begin //本地文件
    Result:=MediaURL;
  end
  else if (MediaURL<>'') then //网络媒体
  begin
    tmpStr:=LowerCase(Copy(MediaURL,1,5));
    if      (tmpStr='rtsp:') then //RealAudio 格式(不处理)
    else if (tmpStr='mms:/') then //MMS 流媒体格式(不处理)
    else if (tmpStr='kplay') then //已经关联的链接类型
    begin //kplay://
      Delete(MediaURL,1,8);
    end
    else if (tmpStr='http:') then //检查 http 类型的链接
    begin
      tmpStr:=LowerCase(Copy(MediaURL,1,17));
      if (tmpStr='http://localhost:') or (tmpStr='http://127.0.0.1:') then
      begin //http://localhost:6868/
        Delete(MediaURL,1,17);
        iIndex:=Pos('/',MediaURL);
        if iIndex>0 then Delete(MediaURL,1,iIndex);
      end;
    end;
    //去掉前面多佘的"/"
    while (Copy(MediaURL,1,1)='/') do
      Delete(MediaURL,1,1);
    Result:=MediaURL;
  end
  else Result:='';
end;

function ComposeURL(const URL:String):String;
var //加上链接头部
  MediaURL,tmpStr:String;
begin
  MediaURL:=Trim(URL);
  if Copy(MediaURL,2,2)=':\' then //本地媒体文件(不处理)
  begin //本地文件
  end
  else if MediaURL<>'' then //判断网络媒体
  begin
    tmpStr:=LowerCase(Copy(MediaURL,1,5));
    if      (tmpStr='rtsp:') then //RealAudio 格式(不处理)
    else if (tmpStr='mms:/') then //MMS 流媒体格式(不处理)
    else if (tmpStr='kplay') then //已经关联的链接类型
    begin
      Delete(MediaURL,1,8);
      MediaURL:='http://localhost:6868/'+MediaURL;
    end
    else if (tmpStr='http:') then //检查 http 类型的链接
    begin
      tmpStr:=LowerCase(Copy(MediaURL,1,17));
      if (tmpStr='http://localhost:') or (tmpStr='http://127.0.0.1:') then
      begin //http://localhost:6868/
      end;
    end
    else MediaURL:='http://localhost:6868/'+MediaURL;
  end;
  Result:=MediaURL;
end;

function GetURL(const URLs:String;var URLList:TStrings):Integer;
var
  URL,Info:String;
  iIndex:Integer;
begin
  Info:=Trim(URLs);
  if (Info<>'') then
  begin
    iIndex:=Pos(vbCrLf,Info); //两个 URL 之间以 vbCrLf 分隔
    while (iIndex>0) do
    begin
      URL:=Trim(Copy(Info,1,iIndex-1));
      Delete(Info,1,iIndex+1);
      URLList.Add(URL);
      iIndex:=Pos(vbCrLf,Info); //两个 URL 之间以 vbCrLf 分隔
    end;
    URLList.Add(Trim(Info));
    Result:=URLList.Count;
  end
  else Result:=0;
end;

function GetURL(var WebBrowser:TWebBrowser;var Link,LinkName:TStrings):String;
var //获取 TWebBrowser 中所有链接
  sDoc:IHTMLDocument2;
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -