فهرست منبع

Merged revisions 10296,10298,10300-10303 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r10296 | yury | 2008-02-11 17:12:41 +0200 (Пн, 11 фев 2008) | 1 line

* Pass const record parameters by reference for all calling conventions on i386-wince. It is needed to be Windows unit Delphi compatible, since WinAPI functions are cdecl on wince.
........
r10301 | yury | 2008-02-11 18:23:54 +0200 (Пн, 11 фев 2008) | 1 line

* Import some functions by ordinal only to be compatible with older versions of wince.
........
r10302 | yury | 2008-02-11 19:34:40 +0200 (Пн, 11 фев 2008) | 1 line

* Fix AV errors when taking pointers of empty strings.
........
r10303 | yury | 2008-02-11 20:43:37 +0200 (Пн, 11 фев 2008) | 1 line

* Do not free invalid pointer in RegSetValueExA wrapper.
........

git-svn-id: branches/fixes_2_2@10309 -

yury 17 سال پیش
والد
کامیت
1532d4e798

+ 1 - 1
compiler/i386/cpupara.pas

@@ -182,7 +182,7 @@ unit cpupara;
                 result:=
                   (not(calloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) and
                    (def.size>sizeof(aint))) or
-                  ((calloption = pocall_mwpascal) and
+                  (((calloption = pocall_mwpascal) or (target_info.system=system_i386_wince)) and
                    (varspez=vs_const));
             end;
           arraydef :

+ 3 - 3
packages/fcl-registry/src/registry.pp

@@ -375,7 +375,7 @@ begin
        SetLength(Result, Info.DataSize-1)
      else
        SetLength(Result, Info.DataSize);
-     GetData(Name,@Result[1],Info.DataSize,Info.RegData);
+     GetData(Name,PChar(Result),Info.DataSize,Info.RegData);
    end
   else
     result:='';
@@ -422,7 +422,7 @@ end;
 procedure TRegistry.WriteExpandString(const Name, Value: string);
 
 begin
-  PutData(Name, @Value[1], Length(Value),rdExpandString);
+  PutData(Name, PChar(Value), Length(Value),rdExpandString);
 end;
 
 procedure TRegistry.WriteFloat(const Name: string; Value: Double);
@@ -438,7 +438,7 @@ end;
 procedure TRegistry.WriteString(const Name, Value: string);
 
 begin
-  PutData(Name, @Value[1], Length(Value), rdString);
+  PutData(Name, PChar(Value), Length(Value), rdString);
 end;
 
 procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);

+ 6 - 7
packages/fcl-registry/src/winreg.inc

@@ -15,10 +15,9 @@ end;
 Function PrepKey(Const S : String) : pChar;
 
 begin
-  If (S[1]<>'\') then
-    Result:=@S[1]
-  else
-    Result:=@S[2];
+  Result:=PChar(S);
+  If Result^='\' then
+    Inc(Result);
 end;
 
 Function RelativeKey(Const S : String) : Boolean;
@@ -71,7 +70,7 @@ Var
   RD : DWord;
 
 begin
-  P := @Name[1];
+  P := PChar(Name);
   If RegQueryValueExA(fCurrentKey,P,Nil,
                       @RD,Buffer,lpdword(@BufSize))<>ERROR_SUCCESS Then
     Result:=-1
@@ -97,7 +96,7 @@ Var
   P: PChar;
 
 begin
-  P:=@ValueName[1];
+  P:=PChar(ValueName);
   With Value do
     Result:=RegQueryValueExA(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize))=ERROR_SUCCESS;
   If Not Result Then
@@ -340,7 +339,7 @@ begin
     rdInteger      : RegDataType:=REG_DWORD;
     rdBinary       : RegDataType:=REG_BINARY;
   end;
-  P:=@Name[1];
+  P:=PChar(Name);
   Result:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize)=ERROR_SUCCESS;
 end;
 

+ 5 - 9
rtl/wince/wininc/aygshell.inc

@@ -465,21 +465,17 @@ function SHDoneButton(hwndRequester: HWND ; dwState : DWORD ): WINBOOL; external
 function SHFindMenuBar(hwnd:HWND) : HWND; external UserDLLAyg name 'SHFindMenuBar';
 function SHFullScreen(hwmdRequester: hWnd; dwState: DWord): WINBOOL; external UserDLLAyg name 'SHFullScreen';  {Pocket PC  special controls}
 function SHGetAutoRunPath( pAutoRunPath : LPTSTR ): WINBOOL; external UserDLLAyg name 'SHGetAutoRunPath';  
-
-function SHHandleWMActivate(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO; dwFlags:DWORD  ): WINBOOL; external UserDLLAyg name 'SHHandleWMActivate';
-function SHHandleWMSettingChange(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO): WINBOOL; external UserDLLAyg name 'SHHandleWMSettingChange';
+function SHHandleWMActivate(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO; dwFlags:DWORD  ): WINBOOL; external UserDLLAyg index 84;
+function SHHandleWMSettingChange(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO): WINBOOL; external UserDLLAyg index 83;
 function SHInitDialog(pshidi: PSHINITDLGINFO): WINBOOL; external UserDLLAyg name 'SHInitDialog';
 function SHInitExtraControls: WINBOOL; external UserDLLAyg name 'SHInitExtraControls';
 procedure SHInputDialog(hwnd : HWND; uMsg : UINT; wParam: WPARAM ); external UserDLLAyg name 'SHInputDialog';
 function SHGetAppKeyAssoc( ptszApp: LPCTSTR ): Byte; external UserDLLAyg name 'SHGetAppKeyAssoc';
-{not exported on PocketPC 4.21 SE , may be smartphone only ? oro06 09-02-06
-function SHLoadImageResource(hinst: HINST; uIdGif: UINT ): HBITMAP; external UserDLLAyg name 'SHLoadImageResource';
-function SHLoadImageFile(pszFileName: LPCTSTR ) : HBITMAP; external UserDLLAyg name 'SHLoadImageFile';
-procedure SHNavigateBack; external UserDLLAyg name 'SHNavigateBack';
-}
 function SHSetAppKeyWndAssoc( bVk: BYTE ; hwnd : HWND ): WINBOOL; external UserDLLAyg name 'SHSetAppKeyWndAssoc';
 function SHSetNavBarText(hwndRequester : HWND; pszText : LPCTSTR): WINBOOL; external UserDLLAyg name 'SHSetNavBarText';
-
+function SHLoadImageResource(hinst: HINST; uIdGif: UINT ): HBITMAP; external UserDLLAyg index 64;
+function SHLoadImageFile(pszFileName: LPCTSTR ) : HBITMAP; external UserDLLAyg index 75;
+procedure SHNavigateBack; external UserDLLAyg index 183;
 function SHSipInfo(uiAction: UINT; uiParam: UINT; pvParam: PVOID; fWinIni: UINT  ): WINBOOL; external UserDLLAyg name 'SHSipInfo';
 function SHSipPreference(hwnd: HWND ; st : SIPSTATE ) : WINBOOL; external UserDLLAyg name 'SHSipPreference';
 function SHRecognizeGesture(var shrg : SHRGINFO): DWORD; external UserDLLAyg name 'SHRecognizeGesture';

+ 8 - 5
rtl/wince/wininc/cemiss.inc

@@ -199,23 +199,26 @@ end;
 
 function RegSetValueExA(hKey:HKEY; lpValueName:LPCSTR; Reserved:DWORD; dwType:DWORD; lpData:pointer;cbData:DWORD):LONG;
 var
-  lpwsValueName: PWideChar;
+  lpwsValueName, ws: PWideChar;
   DataBuf: pointer;
   sz: DWORD;
 begin
  lpwsValueName:=PCharToPWideChar(lpValueName);
  if dwType in [REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ] then begin
-   DataBuf:=PCharToPWideChar(lpData, cbData, @sz);
+   ws:=PCharToPWideChar(lpData, cbData, @sz);
    if (cbData > 0) and (PChar(lpData)[cbData - 1] <> #0) then
      Inc(sz, SizeOf(WideChar));
    cbData:=sz;
+   DataBuf:=ws;
  end
- else
+ else begin
    DataBuf:=lpData;
+   ws:=nil;
+ end;
  Result:=RegSetValueExW(hKey, lpwsValueName, Reserved, dwType, DataBuf, cbData);
  FreeMem(lpwsValueName);
- if DataBuf <> nil then
-   FreeMem(DataBuf);
+ if ws <> nil then
+   FreeMem(ws);
 end;
 
 {$endif read_implementation}