Delphi 一些常用函数

最新推荐文章于 2023-01-29 13:18:12 发布

happycyp

最新推荐文章于 2023-01-29 13:18:12 发布

阅读量1.2k

点赞数

分类专栏： Delphi 文章标签： delphi string integer windows 语言

本文链接：https://blog.csdn.net/happycyp/article/details/3368314

版权

Delphi 专栏收录该内容

7 篇文章 1 订阅

订阅专栏

 
 //创建快捷方式 
procedure CreateShellLink(const DestPath, LinkName, LinkAppPath,
  LinkArgs, Description: string);
const
  SW_NORMAL = 1;
var
  aObj: IUnknown;
  WFileName: WideString;
  sPath: string;
begin
  try
    OleInitialize(nil); //初始化OLE库，在使用OLE函数前必须调用初始化 
    aObj := CreateComObject(CLSID_ShellLink);
    with aObj as IShellLink do begin
     {对MS-DOS程序,一般建议使用SetShowCmd(SW_SHOWMAXIMIZED);}
     //SetShowCmd(SW_NORMAL); 
      SetArguments(Pchar(LinkArgs));
      SetPath(Pchar(LinkAppPath));
      sPath := ExtractFilePath(LinkAppPath);
      SetWorkingDirectory(Pchar(sPath));
      SetDescription(Pchar(Description));
    end;
    WFileName := DestPath + '/' + LinkName;
   {将一个String赋给WideString，转换过程由Delphi自动完成}
    (aObj as IPersistFile).Save(PWChar(WFileName), False);
  finally
    OleUninitialize; //关闭OLE库，此函数必须与OleInitialize成对调用 
  end;
end;
{调用
      CreateShellLink(DirStart, 'Uninstall.lnk',
        GetProgramPath + MuzDir + '/'+'uninst.exe', '', '乐乐吧');
}
function GetProgramPath: string;
var
  s: string;
begin
  s := GetEnvironmentVariable('ProgramFiles');
  Result := IncludeTrailingPathDelimiter(s);
end;
/复制目录
function CopyDirectory(Source: string; pDirectory: string; pFilter: string): boolean;
//目录拷贝source :源目录  directory:目标目录  pFilter:文件类型筛选'/*.*'或'/*.???' 
var
  OpStruc: TSHFileOpStruct;
begin
  FillChar(OpStruc, SizeOf(OpStruc), 0);
  with OpStruc do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := PChar(Source + #0);
    pTo := PChar(pDirectory + #0);
    fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR OR FOF_SILENT;
    fAnyOperationsAborted := True;
    hNameMappings := nil;
    lpszProgressTitle := nil;
  end;
  if ShFileOperation(OpStruc) = 0 then
    Result := True
  else
    Result := false;
end;
function DeleteDirAndFile(const ADir: string): Boolean;
{var
  OpStruc: TSHFileOpStructW;
begin
  FillChar(OpStruc, SizeOf(OpStruc), 0);
  with OpStruc do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PWideChar(ADir);
    pTo := nil;
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOERRORUI;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    //lpszProgressTitle := nil; 
  end;
  if ShFileOperationW(OpStruc) = 0 then
    Result := True
  else
    Result := false;
end; }
var
  fos : TSHFileOpStruct;
begin
  FillChar(fos, SizeOf(fos), 0);
  with fos do
  begin
    wFunc  := FO_DELETE;
    pFrom  := PChar(ADir);
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
  end;
  if ShFileOperation(fos) = 0 then
    Result := True
  else
    Result := false;
end;
//查看Windows操作系统语言 
function IsChnSimplifyWindows(var iType: Integer): Boolean;
var
  LangID: Integer;
begin
  LangID := GetSystemDefaultLangID;
  Result := False;
  iType := -1;
  //ShowMessage(Languages.NameFromLocaleID[LangID]); 
  if LangID = ((SUBLANG_CHINESE_SIMPLIFIED shl 10) or LANG_CHINESE) then
  begin
    iType := 0; //简体 
    Result := True;
    Exit;
  end;
  if LangID = ((SUBLANG_CHINESE_TRADITIONAL shl 10) or LANG_CHINESE) then
  begin
    iType := 1; //繁体 
    Exit;
  end;
  if LangID = ((SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH) then
  begin
    iType := 2; //English 
    Exit;
  end;
end;
//Pos 的 Wide版本 
function WidePMatch(const M: WideString; const P: PWideChar): Boolean;
var
  I, L: Integer;
  Q, R: PWideChar;
begin
  L := Length(M);
  if L = 0 then
  begin
    Result := False;
    Exit;
  end;
  R := Pointer(M);
  Q := P;
  for I := 1 to L do
    if R^ <> Q^ then
    begin
      Result := False;
      Exit;
    end else
    begin
      Inc(R);
      Inc(Q);
    end;
  Result := True;
end;
function WidePos(const F: WideString; const S: WideString; const StartIndex: Integer = 1): Integer;
var
  P: PWideChar;
  I, L: Integer;
begin
  L := Length(S);
  if (StartIndex > L) or (StartIndex < 1) then
  begin
    Result := 0;
    Exit;
  end;
  P := Pointer(S);
  Inc(P, StartIndex - 1);
  for I := StartIndex to L do
    if WidePMatch(F, P) then
    begin
      Result := I;
      Exit;
    end else
      Inc(P);
  Result := 0;
end;
//保存日志 
procedure SaveLog(AMsg: WideString);
var
  f: textfile;
  fileName: WideString;
begin
  fileName := WideExtractFilePath(ParamStr(0)) + FormatDateTime('YYYYMMDD', Now) + '.log';
  AssignFile(f, fileName);
  if not WideFileExists(fileName) then
    Rewrite(f)
  else
    Append(F);
  Writeln(f, FormatDateTime('YYYY-MM-DD HH:NN:SS: ', Now) + AMsg);
  CloseFile(f);
end;
function GetLocalFileSize(AFileName: WideString): DWORD;
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    Result := fs.Size;
  finally
    fs.Free;
  end;
end;
function HexColorToColor(AColor: string): TColor;
var
  sR, sG, sB: string;
begin
  AColor := StringReplace(AColor, '#', '', []);
  sR := Copy(AColor, 5, 2);
  sG := Copy(AColor, 3, 2);
  sB := Copy(AColor, 1, 2);
  Result := StrToInt64('$' + sR + sG + sB);
end;
function ChAnsiToWide(const StrA: AnsiString): WideString;
var
  nLen: integer;
begin
  Result := StrA;
  if Result <> '' then
  begin
    nLen := MultiByteToWideChar(936, 1, PChar(@StrA[1]), -1, nil, 0);
    SetLength(Result, nLen - 1);
    if nLen > 1 then
      MultiByteToWideChar(936, 1, PChar(@StrA[1]), -1, PWideChar(@Result[1]), nLen - 1);
  end;
end;
function ChWideToAnsi(const StrW: WideString): AnsiString;
var
  nLen: integer;
begin
  Result := StrW;
  if Result <> '' then
  begin
    nLen := WideCharToMultiByte(936, 624, @StrW[1], -1, nil, 0, nil, nil);
    SetLength(Result, nLen - 1);
    if nLen > 1 then
      WideCharToMultiByte(936, 624, @StrW[1], -1, @Result[1], nLen - 1, nil, nil);
  end;
end;
function GetString(sInput, sSplit: Widestring;
                  var sAllLeft: Widestring): Widestring;
var
  SplitLen ,iSplitPos: integer;
  sTmp : Widestring;
begin
  SplitLen := Length(sSplit);   //分隔符的长度 cyp 
  iSplitPos := WidePos(sSplit,sInput);  //分隔符的位置 
  sTmp := sInput;
  if iSplitPos <= 0 then
  begin
    Result := sTmp;
    sAllLeft := '';
    Exit;
  end;
 //余下的所有字符 
  sAllleft := Copy(sTmp, iSplitPos+SplitLen, Length(sTmp) - iSplitPos );
  sTmp := Copy(sTmp, 1, iSplitPos - 1 );
  Result := sTmp;
end;
 

happycyp

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
Delphi 一些常用函数

//创建快捷方式 procedure CreateShellLink(const DestPath, LinkName, LinkAppPath, LinkArgs, Description: string);const SW_NORMAL = 1;var aObj: IUnknown; WFileName: WideString; sPath:
复制链接

扫一扫