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
|
#!/usr/bin/perl -w
my $objects_dir = $ARGV[0];
my $deffile = $ARGV[1];
my $dllFile = $ARGV[2];
my $target = $ARGV[3];
my @exports;
my @isData;
open (HANDLE, "< $deffile") or die ("Could not open $deffile");
while (<HANDLE>) {
if (/([a-z0-9_]+)[ ]+\@/ixg) {
push (@exports, $1);
if (/\bDATA\b/x) {
push (@isData, 1);
} else {
push (@isData, 0);
}
}
}
close(HANDLE);
my @ordinalfiles;
my $vtblExports;
open($vtblExports, "> $objects_dir/VtblExports.s") or die("Could not open $objects_dir/VtblExports.s");
print($vtblExports "\tAREA |.directive|, NOALLOC, READONLY, ALIGN=2\n");
print($vtblExports "\tDCB \"#\<SYMEDIT\>#\\n\"\n");
for (my $c = 1; $c < scalar(@exports) + 1; $c++) {
my $symbol = $exports[$c - 1];
my $genstubs;
my $dllFileWithId = $dllFile;
$dllFileWithId =~ s/^(.*)(\.dll)$/$1\{00010000\}\[e001b2dc\]$2/x;
if ($isData[$c - 1]) {
printf ($vtblExports "\tDCB \"IMPORT #<DLL>$dllFileWithId#<\\\\DLL>%x AS $symbol \\n\"\n", $c);
} else {
open ($genstubs, "| winewrapper genstubs.exe") or die ("Could not execute genstubs");
printf ($genstubs "$objects_dir/ordinal-$c.o $symbol #<DLL>$dllFileWithId#<\\DLL>%x\n", $c);
push (@ordinalfiles, "$objects_dir/ordinal-$c.o");
close ($genstubs);
}
}
print($vtblExports "\tEND\n");
close($vtblExports);
my $result = system("armasm --apcs /inter -o $objects_dir/VtblExports.o $objects_dir/VtblExports.s");
die("Could not execute armar") if ($result);
my $via;
open ($via, "> $objects_dir/input.via") or die("Could not open $objects_dir/input.via");
print ($via join("\n", @ordinalfiles));
print ($via "\n$objects_dir/VtblExports.o\n");
close($via);
$result = system("armar --create $target --via $objects_dir/input.via");
die("Could not execute armar") if ($result);
exit 0
|
