******************************************************************* *-----------------------------------------------------------------* * * * Copyright(c) by Bernd Riemke * * Riemke-IT Solutions * * An den Ruschen 27a * * D-28816 Stuhr * * * *-----------------------------------------------------------------* $SET OOCTRL(+P) * * * SET-SHORTCUT.CBL Erstellen von ShortCuts... * ---------------- -------------------------- * * LETZTE ÄNDERUNG: * ================ * 01.01.2017 Bernd Riemke * - Angelegt * * *================================================================= IDENTIFICATION DIVISION. PROGRAM-ID. SET-SHORTCUT. AUTHOR. BERND RIEMKE. INSTALLATION. BERND RIEMKE. DATE-WRITTEN. 01-Januar-2017. DATE-COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. CALL-CONVENTION 66 IS WINAPI DECIMAL-POINT IS COMMA. SOURCE-COMPUTER. IBM-PC-COMP. OBJECT-COMPUTER. IBM-PC-COMP. * INPUT-OUTPUT SECTION. *--------------------- * FILE-CONTROL. *------------- * CLASS-CONTROL. *------------- wshshell is class "$OLE$WScript.Shell" . DATA DIVISION. *============== * FILE SECTION. *------------- * WORKING-STORAGE SECTION. *======================== * 01 TERM-FIELD PIC X(256). 01 I PIC X(4) COMP-5. 01 J PIC X(4) COMP-5. * 01 THESHELL OBJECT REFERENCE. 01 THEDESKTOP OBJECT REFERENCE. 01 SPECIALFOLDERS OBJECT REFERENCE. 01 THESHORTCUT OBJECT REFERENCE. 01 THELINKPATH PIC X(300). 01 ANINT PIC 9(9) COMP-5. 01 ZWI-NAME PIC X(256). 01 ZWI-KOMMENTAR PIC X(256). 01 ZWI-PROGRAMM PIC X(256). 01 ZWI-ZIEL-PFAD PIC X(256). 01 THESTARTMENU PIC X(300). 01 PROCPTR USAGE IS PROCEDURE-POINTER. $set constant UNICODE (0) copy "wintypes.cpy". 78 CSIDL-DESKTOP value h"0000". 78 CSIDL-INTERNET value h"0001". 78 CSIDL-PROGRAMS value h"0002". 78 CSIDL-CONTROLS value h"0003". 78 CSIDL-PRINTERS value h"0004". 78 CSIDL-PERSONAL value h"0005". 78 CSIDL-FAVORITES value h"0006". 78 CSIDL-STARTUP value h"0007". 78 CSIDL-RECENT value h"0008". 78 CSIDL-SENDTO value h"0009". 78 CSIDL-BITBUCKET value h"000a". 78 CSIDL-STARTMENU value h"000b". 78 CSIDL-DESKTOPDIRECTORY value h"0010". 78 CSIDL-DRIVES value h"0011". 78 CSIDL-NETWORK value h"0012". 78 CSIDL-NETHOOD value h"0013". 78 CSIDL-FONTS value h"0014". 78 CSIDL-TEMPLATES value h"0015". 78 CSIDL-COMMON-STARTMENU value h"0016". 78 CSIDL-COMMON-PROGRAMS value h"0017". 78 CSIDL-COMMON-STARTUP value h"0018". 78 CSIDL-COMMON-DESKTOPDIRECTORY value h"0019". 78 CSIDL-APPDATA value h"001a". 78 CSIDL-PRINTHOOD value h"001b". 78 CSIDL-COMMON-FAVORITES value h"001f". 78 CSIDL-INTERNET-CACHE value h"0020". 78 CSIDL-COOKIES value h"0021". 78 CSIDL-HISTORY value h"0022". 01 RETVAL BOOL. ******************************************************************* LINKAGE SECTION. *---------------- 01 LINK-SHORTCUT. * * ShortCuts Einbauen in: * ====================== * * LINK-SHORTCUT-FUNKTION: 01 = Desktop * 02 = Start Menue * 03 = Start / Programme * 04 = Favoriten * 05 = Senden an ... * 06 = Autostart ... * 02 LINK-SHORTCUT-FUNKTION PIC 9(02). * * * Bezeichnung des ShortCuts der angezeigt werden soll * =================================================== * 02 LINK-SHORTCUT-NAME PIC X(256). * * * Kommentar des ShortCuts (Auf Link Rechte Maustaste) * =================================================== * 02 LINK-SHORTCUT-KOMMENTAR PIC X(256). * * * Programm Aufruf der hinter dem Link liegt * ========================================= * 02 LINK-SHORTCUT-PRG-AUFRUF PIC X(256). * * * ZielPfad * ========= * * 02 LINK-SHORTCUT-ZIEL-PFAD PIC X(256). * * Return Wert * =========== * 02 LINK-SHORTCUT-RET-WERT PIC 99. 02 LINK-SHORTCUT-RET-KOMMENTAR PIC X(80). ******************************************************************* PROCEDURE DIVISION USING LINK-SHORTCUT. *--------------------------------------- * HAUPTPROGRAMM SECTION. * PERFORM VORLAUF. PERFORM HAUPTLAUF. PERFORM NACHLAUF. HAUPTPROGRAMM-E. * EXIT PROGRAM. STOP RUN. * ****************************************************************** VORLAUF SECTION. *---------------- INITIALIZE TERM-FIELD, i, j, THESHELL, THEDESKTOP, SPECIALFOLDERS, THESHORTCUT, THELINKPATH, ANINT, ZWI-NAME, ZWI-KOMMENTAR, ZWI-PROGRAMM, ZWI-ZIEL-PFAD. INVOKE WSHSHELL "new" RETURNING THESHELL. SET PROCPTR TO ENTRY "SHELL32.DLL". MOVE LINK-SHORTCUT-NAME TO TERM-FIELD. PERFORM NULL-TERMINATE-ROUTINE. MOVE TERM-FIELD TO ZWI-NAME. MOVE LINK-SHORTCUT-KOMMENTAR TO TERM-FIELD. PERFORM NULL-TERMINATE-ROUTINE. MOVE TERM-FIELD TO ZWI-KOMMENTAR. MOVE LINK-SHORTCUT-PRG-AUFRUF TO TERM-FIELD. PERFORM NULL-TERMINATE-ROUTINE. MOVE TERM-FIELD TO ZWI-PROGRAMM. MOVE LINK-SHORTCUT-ZIEL-PFAD TO TERM-FIELD. PERFORM NULL-TERMINATE-ROUTINE. MOVE TERM-FIELD TO ZWI-ZIEL-PFAD. VORLAUF-EE. EXIT. ****************************************************************** HAUPTLAUF SECTION. *---------------- IF LINK-SHORTCUT-FUNKTION NOT NUMERIC MOVE "Abbruch ! ShortCut-Funktion ist nicht Numerisch" TO LINK-SHORTCUT-RET-KOMMENTAR MOVE 98 TO LINK-SHORTCUT-RET-WERT EXIT SECTION END-IF. IF LINK-SHORTCUT-FUNKTION = 0 OR LINK-SHORTCUT-FUNKTION > 6 MOVE "Abbruch ! ShortCut-Funktion ist Falsch !" TO LINK-SHORTCUT-RET-KOMMENTAR MOVE 99 TO LINK-SHORTCUT-RET-WERT EXIT SECTION END-IF. EVALUATE LINK-SHORTCUT-FUNKTION WHEN 01 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-COMMON-DESKTOPDIRECTORY BY VALUE 0 RETURNING RETVAL END-CALL WHEN 02 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-COMMON-STARTMENU BY VALUE 0 RETURNING RETVAL END-CALL WHEN 03 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-COMMON-PROGRAMS BY VALUE 0 RETURNING RETVAL END-CALL WHEN 04 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-FAVORITES BY VALUE 0 RETURNING RETVAL END-CALL WHEN 05 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-SENDTO BY VALUE 0 RETURNING RETVAL END-CALL WHEN 06 CALL WINAPI "SHGetSpecialFolderPathA" USING BY VALUE 0 BY REFERENCE THESTARTMENU BY VALUE CSIDL-STARTUP BY VALUE 0 RETURNING RETVAL END-CALL WHEN OTHER CONTINUE END-EVALUATE. STRING THESTARTMENU DELIMITED BY X"00" "\" DELIMITED BY SIZE ZWI-NAME DELIMITED BY X"00" ".LNK" DELIMITED BY SIZE X"00" DELIMITED BY SIZE INTO THELINKPATH END-STRING. INVOKE THESHELL "CreateShortCut" USING THELINKPATH RETURNING THESHORTCUT. INVOKE THESHORTCUT "setDescription" USING ZWI-KOMMENTAR. INVOKE THESHORTCUT "setTargetPath" USING ZWI-PROGRAMM. INVOKE THESHORTCUT "SetWorkingDirectory" USING ZWI-ZIEL-PFAD. INVOKE THESHORTCUT "save". HAPUTLAUF-EE. EXIT. ****************************************************************** NACHLAUF SECTION. *---------------- NACHLAUF-EE. EXIT. ****************************************************************** NULL-TERMINATE-ROUTINE SECTION. *------------------------------- MOVE LENGTH OF TERM-FIELD TO J. PERFORM VARYING I FROM J BY -1 UNTIL I = 0 IF TERM-FIELD(I:1) NOT = SPACES AND NOT = X"00" ADD 1 TO I MOVE X"00" TO TERM-FIELD(I:1) EXIT SECTION END-IF END-PERFORM. MOVE X"00" TO TERM-FIELD(J:1). NULL-TERMINATE-ROUTINE-EE. EXIT. ****************************************************************** ****************************************************************** ****************************************************************** ****************************************************************** ******************************************************************