1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105:
| program Copy;
{$APPTYPE CONSOLE}
uses SysUtils, Windows, Dialogs, FileCtrl, ActiveX, ShlObj, ComObj;
const CSIDL_STARTUP = $0007; function PfadAendern: string; begin SelectDirectory('Verzeichnis wählen, in welches kopiert werden soll.', 'Arbeitsplatz', Result); end;
function CreateLink(const AFilename, ALNKFilename, ADescription: string) : Boolean; var psl : IShellLink; ppf : IPersistFile; wsz : PWideChar; begin result:=false; if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_inPROC_SERVER, IID_IShellLinkA, psl)) then begin psl.SetPath(PChar(AFilename)); psl.SetDescription(PChar(ADescription)); psl.SetWorkingDirectory(PChar(ExtractFilePath(AFilename))); if SUCCEEDED(psl.QueryInterface(IPersistFile, ppf)) then begin GetMem(wsz, MAX_PATH*2); try MultiByteToWideChar(CP_ACP, 0, PChar(ALNKFilename), -1, wsz, MAX_PATH); ppf.Save(wsz, true); result:=true; finally FreeMem(wsz, MAX_PATH*2); end; end; end; end;
function GetShellFolder(CSIDL: integer): string; var pidl : PItemIdList; FolderPath : string; SystemFolder : Integer; Malloc : IMalloc; begin Malloc := nil; FolderPath := ''; SHGetMalloc(Malloc); if Malloc = nil then begin Result := FolderPath; Exit; end; try SystemFolder := CSIDL; if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then begin SetLength(FolderPath, max_path); if SHGetPathFromIDList(pidl, PChar(FolderPath)) then begin SetLength(FolderPath, length(PChar(FolderPath))); end; end; Result := FolderPath; finally Malloc.Free(pidl); end; end;
procedure mach(Pname:string); var PathCreate: string; begin Pathcreate:=PfadAendern+'\'+PName; CreateDirectory(PChar(PathCreate),nil);
WriteLN('Directory created:');WriteLN(Pathcreate);
CreateLink(Pathcreate+'\'+PName+'.exe', GetShellFolder($0007)+'\'+Pname+'.exe.lnk', 'Testverknüpfung'); WriteLN(GetShellFolder($0007));
end;
begin mach('Test'); write('test');
ReadLN; end. |