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

📄 dws2mflibmodule.pas

📁 script language
💻 PAS
📖 第 1 页 / 共 5 页
字号:
procedure Tdws2MFLib.dws2UnitFileFunctionsFileListEval(Info: TProgramInfo);
var
  SL: TStringList;
begin
  SL := ScanForFiles(Info['FileName'], Info['Recurse'], Info['Hidden'], True,
    Info['Dirs']);
  Info['Result'] := Info.Vars['TStringList'].GetConstructor('Create', SL).Call.Value;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsFileSizeEval(Info: TProgramInfo);
begin
  Info['Result'] := Integer(FileSize(Info['FileName']));
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsMakePathEval(Info: TProgramInfo);
begin
  Info['Result'] := MakePath(Info['Drive'], Info['Dir'], Info['Name'],
    Info['Ext']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsMoveFileEval(Info: TProgramInfo);
var
  Source,
    Target: string;
begin
  Source := Info['Source'];
  Target := Info['Target'];
  Info['Result'] := MoveFile(PChar(Source), PChar(Target));
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsMoveFileExEval(
  Info: TProgramInfo);
var
  Source,
    Target: string;
begin
  Source := Info['Source'];
  Target := Info['Target'];
  if Target = '' then
    Info['Result'] := MoveFileEx(PChar(Source), nil, Info['Flags'])
  else
    Info['Result'] := MoveFileEx(PChar(Source), PChar(Target), Info['Flags']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsReadOnlyPathEval(
  Info: TProgramInfo);
begin
  Info['Result'] := ReadOnlyPath(Info['Path']);
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsSplitPathEval(
  Info: TProgramInfo);
var
  Drive,
    Dir,
    Name,
    Ext: string;
begin
  SplitPath(Info['Path'], Drive, Dir, Name, Ext);
  Info['Drive'] := Drive;
  Info['Dir'] := Dir;
  Info['Name'] := Name;
  Info['Ext'] := Ext;
end;

procedure Tdws2MFLib.dws2UnitFileFunctionsSubdirectoryExistsEval(
  Info: TProgramInfo);
begin
  Info['Result'] := SubdirectoryExists(Info['Dir']);
end;

// ****************************************************************************
// *** Info Functions *********************************************************
// ****************************************************************************

function _GetRegistryString(Root: HKey; Key, Name: string): string;
var
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey := Root;
    if Reg.OpenKey(Key, False) then
      Result := Reg.ReadString(Name);
  finally
    Reg.Free;
  end;
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetAllUsersDesktopDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, EKey, 'Common Desktop');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetAllUsersProgramsDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, EKey,
    'Common Programs');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetAllUsersStartmenuDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, EKey,
    'Common Start Menu');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetAllUsersStartupDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, EKey, 'Common Startup');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetAppdataDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'AppData');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetCacheDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Cache');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetChannelFolderNameEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey,
    'ChannelFolderName');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetCommonFilesDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey, 'CommonFilesDir');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetComputerNameEval(
  Info: TProgramInfo);
var
  CN: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  L: DWORD;
begin
  L := MAX_COMPUTERNAME_LENGTH;
  if GetComputerName(CN, L) then
    Info['Result'] := string(CN)
  else
    Info['Result'] := '';
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetConsoleTitleEval(
  Info: TProgramInfo);
var
  CT: array[0..MAX_PATH] of Char;
begin
  if GetConsoleTitle(CT, MAX_PATH) > 0 then
    Info['Result'] := string(CT)
  else
    Info['Result'] := '';
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetCookiesDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Cookies');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetCPUSpeedEval(
  Info: TProgramInfo);
const
  DelayTime = 500; // measure time in ms
var
  TimerHi,
    TimerLo: DWORD;
  PriorityClass,
    Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
        dw 310Fh // rdtsc
        mov TimerLo, eax
        mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
        dw 310Fh // rdtsc
        sub eax, TimerLo
        sbb edx, TimerHi
        mov TimerLo, eax
        mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);

  Info['Result'] := TimerLo / (1000.0 * DelayTime);
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetDesktopDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Desktop');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetDevicePathEval(
  Info: TProgramInfo);
var
  Dir: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(Dir, MAX_PATH);
  Info['Result'] := string(Dir) +
    Copy(_GetRegistryString(HKEY_LOCAL_MACHINE, WKey, 'DevicePath'), 13, 255);
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetEnvironmentVariableEval(
  Info: TProgramInfo);
var
  EV: array[0..MAX_PATH] of Char;
  P: PChar;
  i: Integer;
begin
  Info['Result'] := '';
  StrPCopy(EV, Info['Name']);
  i := GetEnvironmentVariable(EV, nil, 0);
  if i > 0 then
  begin
    GetMem(P, i);
    try
      if GetEnvironmentVariable(EV, P, i) > 0 then
        Info['Result'] := string(P);
    finally
      FreeMem(P);
    end;
  end;
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetFavoritesDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Favorites');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetFontsDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Fonts');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetHistoryDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'History');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetLinkfolderNameEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey, 'LinkFolderName');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetMediaPathEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey, 'MediaPath');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetNethoodDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'NetHood');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetPersonalDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Personal');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetPFAccessoriesNameEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey,
    'PF_AccessoriesName');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetPrinthoodDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'PrintHood');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetProgramfilesDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey,
    'ProgramFilesDir');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetProgramsDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Programs');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetRecentDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Recent');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetSendtoDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'SendTo');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetSMAccessoriesNameEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_LOCAL_MACHINE, WKey,
    'SM_AccessoriesName');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetStartmenuDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Start Menu');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetStartupDirectoryEval(
  Info: TProgramInfo);
begin
  Info['Result'] := _GetRegistryString(HKEY_CURRENT_USER, EKey, 'Startup');
end;

procedure Tdws2MFLib.dws2UnitInfoFunctionsGetSystemDirectoryEval(
  Info: TProgramInfo);
var
  Dir: array[0..MAX_PATH] of Char;
begin
  GetSystemDirectory(Dir, MAX_PATH);

⌨️ 快捷键说明

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