Ticket #677: padre.2.c

File padre.2.c, 3.7 KB (added by dolmen, 4 years ago)

Unfinished launcher (need binding of $X to swWPerlExe)

Line 
1/**
2 * Padre Win32 executable Launcher
3 * @author Olivier Mengué <dolmen@cpan.org>
4 */
5#define WIN32_LEAN_AND_MEAN
6#define STRICT
7
8#define _WIN32_WINNT 0x0501
9#include <windows.h>
10#include <tchar.h>
11
12
13#include <EXTERN.h>               /* from the Perl distribution     */
14#include <perl.h>                 /* from the Perl distribution     */
15
16#include "padre-rc.h"
17
18
19static void LocalizedMessageBox(LPCTSTR lpMessage, LPCTSTR lpTitle, DWORD dwFlags)
20{
21    HMODULE hModule;
22    TCHAR szTitle[256];
23    TCHAR szMessage[256];
24
25    hModule = GetModuleHandle(NULL);
26    if (IS_INTRESOURCE(lpMessage)) {
27        LoadString(hModule, (UINT)lpMessage, szMessage, sizeof(szMessage)/sizeof(szMessage[0]));
28        lpMessage = szMessage;
29    }
30    if (IS_INTRESOURCE(lpTitle)) {
31        LoadString(hModule, (UINT)lpTitle, szTitle, sizeof(szTitle)/sizeof(szTitle[0]));
32        lpTitle = szTitle;
33    }
34    MessageBox(NULL, lpMessage, lpTitle, dwFlags);
35}
36
37static BOOL FileExists(LPCTSTR lpFileName)
38{
39    DWORD att = GetFileAttributes(lpFileName);
40    return (att != INVALID_FILE_ATTRIBUTES); //&& (att & (FILE_ATTRIBUTE_DEVICE|FILE_ATTRIBUTE_DIRECTORY) == 0);
41}
42
43static int GetDirectory(LPTSTR lpDir, LPCTSTR lpFilename, int iBufSize)
44{
45    int len, len2;
46    LPCTSTR p;
47    LPTSTR q;
48
49    len = lstrlen(lpFilename);
50    if (len == 0) {
51        lpDir[0] = _T('\0');
52        return 0;
53    }
54    p = lpFilename + len;
55    while (--p > lpFilename) {
56        if (*p == _T('\\') || *p == _T('/'))
57            break;
58    };
59    len = p - lpFilename;
60    if (lpDir == lpFilename) {
61        *(LPTSTR)p = _T('\0');
62    } else {
63        if (len+1 > iBufSize) {
64            lpDir[0] = _T('\0');
65            return 0;
66        }
67        p = lpFilename;
68        q = lpDir;
69        len2 = len;
70        while (len2--)
71            *q++ = *p++;
72        *q = _T('\0');
73    }
74    return len;
75}
76
77
78
79int main(int argc, char **argv, char **env)
80{
81    // Padre.exe path
82    TCHAR szExePath[MAX_PATH];
83    // Padre script path
84    TCHAR szPadre[MAX_PATH];
85    // wperl.exe path
86    TCHAR szWPerlExePath[MAX_PATH];
87    HMODULE hModule;
88    DWORD dwLength;
89    HANDLE hHeap;
90    char **new_argv;
91    int i;
92    int r;
93
94    hModule = GetModuleHandle(NULL);
95    // Find the the executable's path
96    dwLength = GetModuleFileName(hModule, szExePath, sizeof(szExePath)/sizeof(szExePath[0]));
97
98
99    // Build the 'padre' script path
100    dwLength = GetDirectory(szPadre, szExePath, sizeof(szPadre)/sizeof(szPadre[0]));
101    lstrcpy(szPadre+dwLength, _T("\\padre"));
102    //MessageBox(NULL, szPadre, "Padre", MB_OK|MB_ICONINFORMATION);
103
104    //At this point we should check if padre script exists or not
105    if (! FileExists(szPadre)) {
106        LocalizedMessageBox(MAKEINTRESOURCE(IDS_ERR_SCRIPT), MAKEINTRESOURCE(IDS_APP_TITLE), MB_OK|MB_ICONERROR);
107        ExitProcess(1);
108    }
109
110    // Rewrite the command line to insert the padre script
111    hHeap = GetProcessHeap();
112    new_argv = HeapAlloc(hHeap, 0, (argc+2)*sizeof(new_argv[0]));
113    new_argv[0] = argv[0];
114    new_argv[1] = "--";
115    new_argv[2] = szPadre;
116    for(i=1; i<argc; i++)
117        new_argv[i+2] = argv[i];
118    argc += 2;
119
120/*
121    // We must set $^X to wperl.exe
122
123    // Get the module of the Perl DLL to which we have been linked
124    if (GetModuleHandleEx(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS
125                        | GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT,
126                        (LPCTSTR)RunPerl, &hModule)) {
127        dwLength = GetModuleFileName(hModule, szWPerlExePath,
128                    sizeof(szWPerlExePath)/sizeof(szWPerlExePath[0]));
129        dwLength = GetDirectory(szWPerlExePath, szWPerlExePath,
130                    sizeof(szWPerlExePath)/sizeof(szWPerlExePath[0]));
131        lstrcpy(szWPerlExePath+dwLength, _T("\\wperl.exe"));
132        if (FileExists(szWPerlExePath))
133            new_argv[0] = szWPerlExePath;
134    }
135*/
136
137    //MessageBox(NULL, new_argv[0], "Padre", MB_OK|MB_ICONINFORMATION);
138   
139
140    r = RunPerl(argc, new_argv, env);
141
142    HeapFree(hHeap, 0, new_argv);
143    return r;
144}
145/**
146# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
147# LICENSE
148# This program is free software; you can redistribute it and/or
149# modify it under the same terms as Perl 5 itself.
150*/
151/* vim:set ts=4 sts=4 sw=4: */