/packages/winunits-base/src/win9xwsmanager.pp

  1{ *********************************************************************
  2    This file is part of the Free Pascal run time library.
  3    Copyright (c) 2011 by Bart Broersma.
  4
  5    See the file COPYING.FPC, included in this distribution,
  6    for details about the copyright.
  7
  8    This program is distributed in the hope that it will be useful,
  9    but WITHOUT ANY WARRANTY; without even the implied warranty of
 10    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
 11
 12 **********************************************************************}
 13
 14unit win9xwsmanager;
 15
 16{**********************************************************************
 17 Objective: to provide minimal WideString Upper- and LowerCase
 18 functionality under Win9x systems.
 19 This is achievd by dynamically linking shlwapi.dll functions.
 20 If this fails a fallback mechanism is provided so that at least all
 21 lower ASCII characters in a WideString are Upper/LowerCased
 22
 23 Without this library UTF8UpperCase/UTF8LowerCase will fail
 24 on win9x systems (which makes many Lazarus LCL controls that
 25 handle strings behave wrong).
 26
 27 You can use this unit in your uses clause independent of yout target OS.
 28 No code will be linked in if yout target is not Windows.
 29 On true Unicode Windows (WinCE, WinNT-based) no additional libraries
 30 will be linked in (see: InitWin9xWSManager).
 31
 32 Currently only LowerWideStringProc and UpperWideStringProc are
 33 replaced on win9x.
 34 Possibly other functions might need replacin too.
 35
 36***********************************************************************}
 37
 38{$mode objfpc}{$H+}
 39interface
 40
 41{$IFDEF WINDOWS}
 42{ $define DEBUG_WIN9X_WSMANAGER} 
 43
 44
 45uses
 46  Windows, SysUtils;
 47
 48{$endif WINDOWS}
 49
 50implementation
 51
 52{$ifdef WINDOWS}
 53
 54type
 55  TShlwapiFunc = function(lpsz: LPWSTR; ccLength: DWORD): DWORD; stdcall;
 56
 57var
 58  CharUpperBuffWrapW: TShlwapifunc = nil;
 59  CharLowerBuffWrapW: TShlwapifunc = nil;
 60  ShlwapiHandle: THandle = 0;
 61  SavedUnicodeStringManager: TUnicodeStringManager;
 62
 63
 64// Win9x**Simple functions do essentially Upper/LowerCase on
 65// lower ASCII characters in the string
 66
 67function Win9xWideUpperSimple(const S: WideString): WideString;
 68const
 69  diff = Ord('a') - Ord('A');
 70var
 71  W: WideChar;
 72  i: Integer;
 73begin
 74  Result := S;
 75  for i := 1 to length(Result) do
 76  begin
 77    W := Result[i];
 78    if (Ord(W) in [Ord(Char('a'))..Ord(Char('z'))]) then
 79    begin
 80      Word(W) := Word(W) - diff;
 81      Result[i] := W;
 82    end;
 83  end;
 84end;
 85
 86function Win9xWideLowerSimple(const S: WideString): WideString;
 87const
 88  diff = Ord('a') - Ord('A');
 89var
 90  W: WideChar;
 91  i: Integer;
 92begin
 93  Result := S;
 94  for i := 1 to length(Result) do
 95  begin
 96    W := Result[i];
 97    if (Ord(W) in [Ord(Char('A'))..Ord(Char('Z'))]) then
 98    begin
 99      Word(W) := Word(W) + diff;
100      Result[i] := W;
101    end;
102  end;
103end;
104
105
106function Win9xWideUpper(const S: WideString): WideString;
107begin
108  Result := S;
109  CharUpperBuffWrapW(PWChar(Result), Length(Result));
110end;
111
112function Win9xWideLower(const S: WideString): WideString;
113begin
114  Result := S;
115  CharLowerBuffWrapW(PWChar(Result), Length(Result));
116end;
117
118
119procedure FreeDll;
120begin
121  {$ifdef DEBUG_WIN9X_WSMANAGER}
122  if IsConsole then writeln('FreeDLL');
123  {$endif}
124  if ShlwapiHandle <> 0 then
125  begin
126    FreeLibrary(ShlwapiHandle);
127    ShlwapiHandle := 0;
128  end;
129end;
130
131
132procedure InitDll;
133var
134  PU,PL: Pointer;
135begin
136  ShlwapiHandle := LoadLibrary('shlwapi.dll');
137  if (ShlwapiHandle <> 0) then
138  begin
139    //shlwapi functions cannot be loaded by name, only by index!
140    PU := GetProcAddress(ShlwapiHandle,PChar(44));
141    if (PU <> nil) then CharUpperBuffWrapW := TShlwapiFunc(PU);
142    PL := GetProcAddress(ShlwapiHandle,PChar(39));
143    if (PL <> nil) then CharLowerBuffWrapW := TShlwapiFunc(PL);
144    {$ifdef DEBUG_WIN9X_WSMANAGER}
145    {$PUSH}{$HINTS OFF}  //suppress hints on Pointer to PtrUInt tyecasting
146    if IsConsole then
147    begin
148      writeln('Successfully loaded shlwapi.dll');
149      if (PU <> nil) then
150        writeln('Assigning CharUpperBuffWrapW @: ',HexStr(PtrUInt(PU),2*sizeof(PtrInt)))
151      else
152        writeln('Unable to load CharUpperBuffWrapW');
153      if (PL <> nil) then
154        writeln('Assigning CharLowerBuffWrapW @: ',HexStr(PtrUInt(PL),2*sizeof(PtrInt)))
155      else
156        writeln('Unable to load CharLowerBuffWrapW');
157    end;
158    {$POP}
159    {$endif DEBUG_WIN9X_WSMANAGER}
160    if (PU = nil) and (PL = nil) then
161    begin
162      FreeDLL;
163    end;
164  end
165  else
166  begin
167    {$ifdef DEBUG_WIN9X_WSMANAGER}
168    writeln('Unable to load shlwapi.dll');
169    {$endif}
170  end;
171end;
172
173
174procedure InitWin9xWSManager;
175var
176  WS: WideString;
177begin
178  SavedUnicodeStringManager := WideStringManager;
179  WS := 'abc';
180  if WideUpperCase(WS) <> 'ABC' then
181  begin
182    InitDLL;
183    if Assigned(CharUpperBuffWrapW) then
184    begin
185      WideStringManager.UpperWideStringProc := @Win9xWideUpper;
186      WS := 'abc';
187      if WideUpperCase(WS) <> 'ABC' then WideStringManager.UpperWideStringProc := @Win9xWideUpperSimple;
188    end
189    else
190    begin
191      WideStringManager.UpperWideStringProc := @Win9xWideUpperSimple;
192    end;
193    if Assigned(CharLowerBuffWrapW) then
194    begin
195      WideStringmanager.LowerWideStringProc := @Win9xWideLower;
196      WS := 'ABC';
197      if WideLowerCase(WS) <> 'abc' then WideStringManager.LowerWideStringProc := @Win9xWideLowerSimple;
198    end
199    else
200    begin
201      WideStringManager.LowerWideStringProc := @Win9xWideLowerSimple;
202    end;
203  end;
204end;
205
206initialization
207  InitWin9xWSManager;
208
209finalization
210  WideStringManager := SavedUnicodeStringManager;
211  if (ShlwapiHandle <> 0) then FreeDll;
212
213{$endif}
214end.
215