Browse Source

--- Merging r24706 into '.':
U packages/fcl-extra/src/win/daemonapp.inc
--- Merging r24707 into '.':
U packages/graph/src/win32/graph.pp
--- Merging r24708 into '.':
U ide/wutils.pas
U ide/winclip.pas
--- Merging r25021 into '.':
U packages/winunits-base/src/winutils.pp
--- Merging r25053 into '.':
U rtl/win/wininc/defines.inc
--- Merging r25087 into '.':
U packages/winunits-base/src/activex.pp

# revisions: 24706,24707,24708,25021,25053,25087
r24706 | marco | 2013-06-01 14:30:00 +0200 (Sat, 01 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-extra/src/win/daemonapp.inc

* Some "-A" 's added.
r24707 | marco | 2013-06-01 14:42:39 +0200 (Sat, 01 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/graph/src/win32/graph.pp

* graph unit win32 fixes.
r24708 | marco | 2013-06-01 14:46:15 +0200 (Sat, 01 Jun 2013) | 1 line
Changed paths:
M /trunk/ide/winclip.pas
M /trunk/ide/wutils.pas

* Clipboard and one occurance of getfullpath fixed for A/W issues.
r25021 | marco | 2013-06-30 18:19:01 +0200 (Sun, 30 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/winunits-base/src/winutils.pp

* Simple Add/remove firewall rule wrapper by d4nn13 (forum)
r25053 | marco | 2013-07-06 22:46:30 +0200 (Sat, 06 Jul 2013) | 2 lines
Changed paths:
M /trunk/rtl/win/wininc/defines.inc

* added layout constants.
r25087 | marco | 2013-07-11 23:33:13 +0200 (Thu, 11 Jul 2013) | 2 lines
Changed paths:
M /trunk/packages/winunits-base/src/activex.pp

* added TElemdesc alias (found it used in Delphi code)

git-svn-id: branches/fixes_2_6@25185 -

marco 12 năm trước cách đây
mục cha
commit
e5de4a8cc1

+ 1 - 1
ide/winclip.pas

@@ -234,7 +234,7 @@ begin
   res:=(SetClipboardData(CF_OEMTEXT,h)=h);
   h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,l+1);
   pp:=pchar(GlobalLock(h));
-  OemToCharBuff(p,pp,l+1);
+  OemToCharBuffA(p,pp,l+1);
   SetClipboardData(CF_TEXT,h);
   GlobalUnlock(h);
   SetTextWinClipBoardData:=res;

+ 1 - 1
ide/wutils.pas

@@ -621,7 +621,7 @@ begin
   GetLongName:=n;
 {$ifdef Windows}
   hs:=n+#0;
-  i:=Windows.GetFullPathName(@hs[1],256,hs2,j);
+  i:=Windows.GetFullPathNameA(@hs[1],256,hs2,j);
   if (i>0) and (i<=high(hs)) then
     begin
       hs:=strpas(hs2);

+ 6 - 6
packages/fcl-extra/src/win/daemonapp.inc

@@ -324,10 +324,10 @@ Const
 Var
   T : TDaemonStartThread;
   Msg : TMsg;
-  TClass: TWndClass;
-  AWClass: TWndClass = (
+  TClass: TWndClassA;
+  AWClass: TWndClassA = (
     style: 0;
-    lpfnWndProc: @DefWindowProc;
+    lpfnWndProc: @DefWindowProcA;
     cbClsExtra: 0;
     cbWndExtra: 0;
     hInstance: 0;
@@ -340,13 +340,13 @@ Var
 begin
   If (GUIHandle=0) then
     begin
-    if not GetClassInfo(HInstance,AWClass.lpszClassName,TClass) then
+    if not GetClassInfoA(HInstance,AWClass.lpszClassName,TClass) then
       begin
       AWClass.hInstance := HInstance;
-      if Windows.RegisterClass(AWClass) = 0 then
+      if Windows.RegisterClassA(AWClass) = 0 then
         DaemonError(SErrWindowClass);
       end;
-    GUIHandle := CreateWindow(AWClass.lpszClassName, Pchar(Title),
+    GUIHandle := CreateWindowA(AWClass.lpszClassName, Pchar(Title),
       HandleOpts, 1,1, 0, 0, 0, 0, HInstance, nil);
     end;
   T:=TDaemonStartThread.Create(P,GUIHandle);

+ 5 - 5
packages/graph/src/win32/graph.pp

@@ -1333,7 +1333,7 @@ begin
          Exit;
       end
     else
-      WindowProcGraph := DefWindowProc(Window, AMessage, WParam, LParam);
+      WindowProcGraph := DefWindowProcA(Window, AMessage, WParam, LParam);
   end;
 end;
 
@@ -1359,7 +1359,7 @@ begin
       if assigned(commandmessagehandler) then
         WindowProcParent:=commandmessagehandler(window,amessage,wparam,lparam);
     else
-      WindowProcParent := DefWindowProc(Window, AMessage, WParam, LParam);
+      WindowProcParent := DefWindowProcA(Window, AMessage, WParam, LParam);
   end;
 end;
 
@@ -1443,7 +1443,7 @@ begin
   WinCreate:=0;
   if UseChildWindow then
     begin
-       ParentWindow:=CreateWindow('FPCGraphWindowMain', windowtitle,
+       ParentWindow:=CreateWindowA('FPCGraphWindowMain', windowtitle,
                   WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or extrastyle, longint(CW_USEDEFAULT), 0,
                   maxx+ChildOffset.Left+ChildOffset.Right+1+
                     2*GetSystemMetrics(SM_CXFRAME),
@@ -1458,7 +1458,7 @@ begin
          end
        else
          exit;
-       hWindow:=CreateWindow('FPCGraphWindowChild',nil,
+       hWindow:=CreateWindowA('FPCGraphWindowChild',nil,
                   WS_CHILD, ChildOffset.Left,ChildOffset.Top,
                   maxx+1,maxy+1,
                   ParentWindow, 0, system.MainInstance, nil);
@@ -1473,7 +1473,7 @@ begin
     end
   else
     begin
-       hWindow:=CreateWindow('FPCGraphWindow', windowtitle,
+       hWindow:=CreateWindowA('FPCGraphWindow', windowtitle,
                   ws_OverlappedWindow or extrastyle, longint(CW_USEDEFAULT), 0,
                   maxx+1+2*GetSystemMetrics(SM_CXFRAME),
                   maxy+1+2*GetSystemMetrics(SM_CYFRAME)+

+ 1 - 1
packages/winunits-base/src/activex.pp

@@ -1744,7 +1744,7 @@ TYPE
                                       0 : (idldesc    : IDLDESC);
                                       1 : (paramdesc  : PARAMDESC);
                                       END;
-
+   TElemDesc	                = tagELEMDESC;
    ELEMDESC                     = tagELEMDESC;
    LPELEMDESC                   = ^ELEMDESC;
    tagVARDESC                   = Record

+ 43 - 1
packages/winunits-base/src/winutils.pp

@@ -18,7 +18,7 @@ unit winutils;
 
 Interface
 
-Uses Windows;
+Uses Windows, ComObj, ActiveX;
 
 // returns True if the currently logged Windows user has Administrator rights. Delphi.about.com
 // From Delphi.about.com with permission, http://delphi.about.com/od/delphitips2007/qt/is_win_admin.htm
@@ -27,6 +27,21 @@ function IsWindowsAdmin: Boolean;
 // Removes Browsers "downloaded" attribute from a file.
 procedure UnBlockFile(const name:String);
 
+const
+  NET_FW_PROFILE2_DOMAIN  = 1;
+  NET_FW_PROFILE2_PRIVATE = 2;
+  NET_FW_PROFILE2_PUBLIC  = 4;
+  NET_FW_IP_PROTOCOL_TCP = 6;
+  NET_FW_IP_PROTOCOL_UDP = 17;
+  NET_FW_ACTION_ALLOW    = 1;  
+
+// add firewall rule e.g. 
+// AddProgramExceptionToFireWall( Application.Title,Application.Title, Application.ExeName, NET_FW_IP_PROTOCOL_TCP, NET_FW_PROFILE2_DOMAIN or NET_FW_PROFILE2_PRIVATE or NET_FW_PROFILE2_PUBLIC);
+procedure AddProgramExceptionToFireWall(Const wsCaption, wsDescription, wsExecutable: WideString; iProtocol,iProfile:Integer);
+
+// remove firewall rule, e.g.  RemoveExceptionFromFW(Application.Title);
+procedure RemoveExceptionFromFW(Const exCaption: WideString);
+
 implementation
 
 const
@@ -91,4 +106,31 @@ begin
  closefile(f);
 end;
 
+procedure AddProgramExceptionToFireWall(Const wsCaption, wsDescription, wsExecutable: WideString; iProtocol, iProfile:Integer);
+var
+  fwPolicy2                :  OleVariant;
+  RulesObject              :  OleVariant;
+  NewRule                  :  OleVariant;
+begin
+  fwPolicy2                := CreateOleObject('HNetCfg.FwPolicy2');
+  RulesObject              := fwPolicy2.Rules;
+  NewRule                  := CreateOleObject('HNetCfg.FWRule');
+  NewRule.Name             := wsCaption;
+  NewRule.Description      := wsDescription;
+  NewRule.Applicationname  := wsExecutable;
+  NewRule.Protocol         := iProtocol;
+  NewRule.Enabled          := TRUE;
+  NewRule.Profiles         := iProfile;
+  NewRule.Action           := NET_FW_ACTION_ALLOW;
+  RulesObject.Add(NewRule);
+end; 
+
+procedure RemoveExceptionFromFW(Const exCaption: WideString);
+var
+  fwPolicy2      : OleVariant;
+begin
+  fwPolicy2      := CreateOleObject('HNetCfg.FwPolicy2');
+  fwPolicy2.Rules.Remove(exCaption);
+end;   
+
 end.

+ 7 - 0
rtl/win/wininc/defines.inc

@@ -1186,6 +1186,13 @@
   { EnumProtocols  }
   { EnumResLangProc  }
 
+  // layout
+   LAYOUT_RTL                         = 1; // Right to left
+   LAYOUT_BTT                         = 2; // Bottom to top
+   LAYOUT_VBH                         = 4; // Vertical before horizontal
+   LAYOUT_ORIENTATIONMASK             = (LAYOUT_RTL or LAYOUT_BTT or LAYOUT_VBH);
+   LAYOUT_BITMAPORIENTATIONPRESERVED  = 8;
+
   // DEVMODE dmDisplayFixedOutput 
      DMDFO_DEFAULT = 0;
      DMDFO_STRETCH = 1;