• R/O
  • SSH
  • HTTPS

mantisbtmonitor: コミット


コミットメタ情報

リビジョン43 (tree)
日時2019-07-30 01:26:00
作者derekwildstar

ログメッセージ

- Projeto de testes para migração para a tecnologia scrap

変更サマリ

差分

--- trunk/testes/Project6.bdsproj (nonexistent)
+++ trunk/testes/Project6.bdsproj (revision 43)
@@ -0,0 +1,177 @@
1+<?xml version="1.0" encoding="utf-8"?>
2+<BorlandProject>
3+ <PersonalityInfo>
4+ <Option>
5+ <Option Name="Personality">Delphi.Personality</Option>
6+ <Option Name="ProjectType"></Option>
7+ <Option Name="Version">1.0</Option>
8+ <Option Name="GUID">{36DE89E7-9379-4DD9-AA74-B82AEEB9589D}</Option>
9+ </Option>
10+ </PersonalityInfo>
11+ <Delphi.Personality>
12+ <Source>
13+ <Source Name="MainSource">Project6.dpr</Source>
14+ </Source>
15+ <FileVersion>
16+ <FileVersion Name="Version">7.0</FileVersion>
17+ </FileVersion>
18+ <Compiler>
19+ <Compiler Name="A">8</Compiler>
20+ <Compiler Name="B">0</Compiler>
21+ <Compiler Name="C">1</Compiler>
22+ <Compiler Name="D">1</Compiler>
23+ <Compiler Name="E">0</Compiler>
24+ <Compiler Name="F">0</Compiler>
25+ <Compiler Name="G">1</Compiler>
26+ <Compiler Name="H">1</Compiler>
27+ <Compiler Name="I">1</Compiler>
28+ <Compiler Name="J">0</Compiler>
29+ <Compiler Name="K">0</Compiler>
30+ <Compiler Name="L">1</Compiler>
31+ <Compiler Name="M">0</Compiler>
32+ <Compiler Name="N">1</Compiler>
33+ <Compiler Name="O">1</Compiler>
34+ <Compiler Name="P">1</Compiler>
35+ <Compiler Name="Q">0</Compiler>
36+ <Compiler Name="R">0</Compiler>
37+ <Compiler Name="S">0</Compiler>
38+ <Compiler Name="T">0</Compiler>
39+ <Compiler Name="U">0</Compiler>
40+ <Compiler Name="V">1</Compiler>
41+ <Compiler Name="W">0</Compiler>
42+ <Compiler Name="X">1</Compiler>
43+ <Compiler Name="Y">1</Compiler>
44+ <Compiler Name="Z">1</Compiler>
45+ <Compiler Name="ShowHints">True</Compiler>
46+ <Compiler Name="ShowWarnings">True</Compiler>
47+ <Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
48+ <Compiler Name="NamespacePrefix"></Compiler>
49+ <Compiler Name="GenerateDocumentation">False</Compiler>
50+ <Compiler Name="DefaultNamespace"></Compiler>
51+ <Compiler Name="SymbolDeprecated">True</Compiler>
52+ <Compiler Name="SymbolLibrary">True</Compiler>
53+ <Compiler Name="SymbolPlatform">True</Compiler>
54+ <Compiler Name="SymbolExperimental">True</Compiler>
55+ <Compiler Name="UnitLibrary">True</Compiler>
56+ <Compiler Name="UnitPlatform">True</Compiler>
57+ <Compiler Name="UnitDeprecated">True</Compiler>
58+ <Compiler Name="UnitExperimental">True</Compiler>
59+ <Compiler Name="HResultCompat">True</Compiler>
60+ <Compiler Name="HidingMember">True</Compiler>
61+ <Compiler Name="HiddenVirtual">True</Compiler>
62+ <Compiler Name="Garbage">True</Compiler>
63+ <Compiler Name="BoundsError">True</Compiler>
64+ <Compiler Name="ZeroNilCompat">True</Compiler>
65+ <Compiler Name="StringConstTruncated">True</Compiler>
66+ <Compiler Name="ForLoopVarVarPar">True</Compiler>
67+ <Compiler Name="TypedConstVarPar">True</Compiler>
68+ <Compiler Name="AsgToTypedConst">True</Compiler>
69+ <Compiler Name="CaseLabelRange">True</Compiler>
70+ <Compiler Name="ForVariable">True</Compiler>
71+ <Compiler Name="ConstructingAbstract">True</Compiler>
72+ <Compiler Name="ComparisonFalse">True</Compiler>
73+ <Compiler Name="ComparisonTrue">True</Compiler>
74+ <Compiler Name="ComparingSignedUnsigned">True</Compiler>
75+ <Compiler Name="CombiningSignedUnsigned">True</Compiler>
76+ <Compiler Name="UnsupportedConstruct">True</Compiler>
77+ <Compiler Name="FileOpen">True</Compiler>
78+ <Compiler Name="FileOpenUnitSrc">True</Compiler>
79+ <Compiler Name="BadGlobalSymbol">True</Compiler>
80+ <Compiler Name="DuplicateConstructorDestructor">True</Compiler>
81+ <Compiler Name="InvalidDirective">True</Compiler>
82+ <Compiler Name="PackageNoLink">True</Compiler>
83+ <Compiler Name="PackageThreadVar">True</Compiler>
84+ <Compiler Name="ImplicitImport">True</Compiler>
85+ <Compiler Name="HPPEMITIgnored">True</Compiler>
86+ <Compiler Name="NoRetVal">True</Compiler>
87+ <Compiler Name="UseBeforeDef">True</Compiler>
88+ <Compiler Name="ForLoopVarUndef">True</Compiler>
89+ <Compiler Name="UnitNameMismatch">True</Compiler>
90+ <Compiler Name="NoCFGFileFound">True</Compiler>
91+ <Compiler Name="ImplicitVariants">True</Compiler>
92+ <Compiler Name="UnicodeToLocale">True</Compiler>
93+ <Compiler Name="LocaleToUnicode">True</Compiler>
94+ <Compiler Name="ImagebaseMultiple">True</Compiler>
95+ <Compiler Name="SuspiciousTypecast">True</Compiler>
96+ <Compiler Name="PrivatePropAccessor">True</Compiler>
97+ <Compiler Name="UnsafeType">False</Compiler>
98+ <Compiler Name="UnsafeCode">False</Compiler>
99+ <Compiler Name="UnsafeCast">False</Compiler>
100+ <Compiler Name="OptionTruncated">True</Compiler>
101+ <Compiler Name="WideCharReduced">True</Compiler>
102+ <Compiler Name="DuplicatesIgnored">True</Compiler>
103+ <Compiler Name="UnitInitSeq">True</Compiler>
104+ <Compiler Name="LocalPInvoke">True</Compiler>
105+ <Compiler Name="MessageDirective">True</Compiler>
106+ <Compiler Name="CodePage"></Compiler>
107+ </Compiler>
108+ <Linker>
109+ <Linker Name="MapFile">0</Linker>
110+ <Linker Name="OutputObjs">0</Linker>
111+ <Linker Name="GenerateHpps">False</Linker>
112+ <Linker Name="ConsoleApp">1</Linker>
113+ <Linker Name="DebugInfo">False</Linker>
114+ <Linker Name="RemoteSymbols">False</Linker>
115+ <Linker Name="GenerateDRC">False</Linker>
116+ <Linker Name="MinStackSize">16384</Linker>
117+ <Linker Name="MaxStackSize">1048576</Linker>
118+ <Linker Name="ImageBase">4194304</Linker>
119+ <Linker Name="ExeDescription"></Linker>
120+ </Linker>
121+ <Directories>
122+ <Directories Name="OutputDir"></Directories>
123+ <Directories Name="UnitOutputDir"></Directories>
124+ <Directories Name="PackageDLLOutputDir"></Directories>
125+ <Directories Name="PackageDCPOutputDir"></Directories>
126+ <Directories Name="SearchPath"></Directories>
127+ <Directories Name="Packages"></Directories>
128+ <Directories Name="Conditionals"></Directories>
129+ <Directories Name="DebugSourceDirs"></Directories>
130+ <Directories Name="UsePackages">False</Directories>
131+ </Directories>
132+ <Parameters>
133+ <Parameters Name="RunParams"></Parameters>
134+ <Parameters Name="HostApplication"></Parameters>
135+ <Parameters Name="Launcher"></Parameters>
136+ <Parameters Name="UseLauncher">False</Parameters>
137+ <Parameters Name="DebugCWD"></Parameters>
138+ <Parameters Name="Debug Symbols Search Path"></Parameters>
139+ <Parameters Name="LoadAllSymbols">True</Parameters>
140+ <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
141+ </Parameters>
142+ <Language>
143+ <Language Name="ActiveLang"></Language>
144+ <Language Name="ProjectLang">$00000000</Language>
145+ <Language Name="RootDir"></Language>
146+ </Language>
147+ <VersionInfo>
148+ <VersionInfo Name="IncludeVerInfo">False</VersionInfo>
149+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
150+ <VersionInfo Name="MajorVer">1</VersionInfo>
151+ <VersionInfo Name="MinorVer">0</VersionInfo>
152+ <VersionInfo Name="Release">0</VersionInfo>
153+ <VersionInfo Name="Build">0</VersionInfo>
154+ <VersionInfo Name="Debug">False</VersionInfo>
155+ <VersionInfo Name="PreRelease">False</VersionInfo>
156+ <VersionInfo Name="Special">False</VersionInfo>
157+ <VersionInfo Name="Private">False</VersionInfo>
158+ <VersionInfo Name="DLL">False</VersionInfo>
159+ <VersionInfo Name="Locale">1046</VersionInfo>
160+ <VersionInfo Name="CodePage">1252</VersionInfo>
161+ </VersionInfo>
162+ <VersionInfoKeys>
163+ <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
164+ <VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
165+ <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
166+ <VersionInfoKeys Name="InternalName"></VersionInfoKeys>
167+ <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
168+ <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
169+ <VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
170+ <VersionInfoKeys Name="ProductName"></VersionInfoKeys>
171+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
172+ <VersionInfoKeys Name="Comments"></VersionInfoKeys>
173+ </VersionInfoKeys>
174+ </Delphi.Personality>
175+ <StarTeamAssociation> </StarTeamAssociation>
176+ <StarTeamNonRelativeFiles> </StarTeamNonRelativeFiles>
177+</BorlandProject>
--- trunk/testes/Project6.dpr (nonexistent)
+++ trunk/testes/Project6.dpr (revision 43)
@@ -0,0 +1,13 @@
1+program Project6;
2+
3+uses
4+ Forms,
5+ Unit9 in 'Unit9.pas' {Form9};
6+
7+{$R *.res}
8+
9+begin
10+ Application.Initialize;
11+ Application.CreateForm(TForm9, Form9);
12+ Application.Run;
13+end.
--- trunk/testes/Project6.dproj (nonexistent)
+++ trunk/testes/Project6.dproj (revision 43)
@@ -0,0 +1,136 @@
1+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
2+ <PropertyGroup>
3+ <ProjectGuid>{36DE89E7-9379-4DD9-AA74-B82AEEB9589D}</ProjectGuid>
4+ <MainSource>Project6.dpr</MainSource>
5+ <Base>True</Base>
6+ <Config Condition="'$(Config)'==''">Debug</Config>
7+ <TargetedPlatforms>129</TargetedPlatforms>
8+ <AppType>Application</AppType>
9+ <FrameworkType>VCL</FrameworkType>
10+ <ProjectVersion>18.4</ProjectVersion>
11+ <Platform Condition="'$(Platform)'==''">Win32</Platform>
12+ </PropertyGroup>
13+ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
14+ <Base>true</Base>
15+ </PropertyGroup>
16+ <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
17+ <Base_Win32>true</Base_Win32>
18+ <CfgParent>Base</CfgParent>
19+ <Base>true</Base>
20+ </PropertyGroup>
21+ <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
22+ <Base_Win64>true</Base_Win64>
23+ <CfgParent>Base</CfgParent>
24+ <Base>true</Base>
25+ </PropertyGroup>
26+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
27+ <Cfg_1>true</Cfg_1>
28+ <CfgParent>Base</CfgParent>
29+ <Base>true</Base>
30+ </PropertyGroup>
31+ <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
32+ <Cfg_1_Win32>true</Cfg_1_Win32>
33+ <CfgParent>Cfg_1</CfgParent>
34+ <Cfg_1>true</Cfg_1>
35+ <Base>true</Base>
36+ </PropertyGroup>
37+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
38+ <Cfg_2>true</Cfg_2>
39+ <CfgParent>Base</CfgParent>
40+ <Base>true</Base>
41+ </PropertyGroup>
42+ <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
43+ <Cfg_2_Win32>true</Cfg_2_Win32>
44+ <CfgParent>Cfg_2</CfgParent>
45+ <Cfg_2>true</Cfg_2>
46+ <Base>true</Base>
47+ </PropertyGroup>
48+ <PropertyGroup Condition="'$(Base)'!=''">
49+ <DCC_DebugInformation>1</DCC_DebugInformation>
50+ <DCC_E>false</DCC_E>
51+ <DCC_F>false</DCC_F>
52+ <DCC_K>false</DCC_K>
53+ <DCC_N>true</DCC_N>
54+ <DCC_S>false</DCC_S>
55+ <DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
56+ <DCC_ImageBase>00400000</DCC_ImageBase>
57+ <SanitizedProjectName>Project6</SanitizedProjectName>
58+ <DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
59+ <VerInfo_Locale>1046</VerInfo_Locale>
60+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
61+ </PropertyGroup>
62+ <PropertyGroup Condition="'$(Base_Win32)'!=''">
63+ <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
64+ <BT_BuildType>Debug</BT_BuildType>
65+ <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
66+ <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
67+ <VerInfo_Locale>1033</VerInfo_Locale>
68+ <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
69+ <Icon_MainIcon>Project6_Icon.ico</Icon_MainIcon>
70+ <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
71+ <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
72+ <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
73+ </PropertyGroup>
74+ <PropertyGroup Condition="'$(Base_Win64)'!=''">
75+ <Icon_MainIcon>Project6_Icon.ico</Icon_MainIcon>
76+ <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
77+ <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
78+ </PropertyGroup>
79+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
80+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
81+ <DCC_DebugInformation>0</DCC_DebugInformation>
82+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
83+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
84+ </PropertyGroup>
85+ <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
86+ <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
87+ <AppEnableHighDPI>true</AppEnableHighDPI>
88+ </PropertyGroup>
89+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
90+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
91+ <DCC_Optimize>false</DCC_Optimize>
92+ <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
93+ </PropertyGroup>
94+ <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
95+ <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
96+ <AppEnableHighDPI>true</AppEnableHighDPI>
97+ </PropertyGroup>
98+ <ItemGroup>
99+ <DelphiCompile Include="$(MainSource)">
100+ <MainSource>MainSource</MainSource>
101+ </DelphiCompile>
102+ <DCCReference Include="Unit9.pas">
103+ <Form>Form9</Form>
104+ </DCCReference>
105+ <BuildConfiguration Include="Debug">
106+ <Key>Cfg_2</Key>
107+ <CfgParent>Base</CfgParent>
108+ </BuildConfiguration>
109+ <BuildConfiguration Include="Base">
110+ <Key>Base</Key>
111+ </BuildConfiguration>
112+ <BuildConfiguration Include="Release">
113+ <Key>Cfg_1</Key>
114+ <CfgParent>Base</CfgParent>
115+ </BuildConfiguration>
116+ </ItemGroup>
117+ <ProjectExtensions>
118+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
119+ <Borland.ProjectType/>
120+ <BorlandProject>
121+ <Delphi.Personality>
122+ <Source>
123+ <Source Name="MainSource">Project6.dpr</Source>
124+ </Source>
125+ </Delphi.Personality>
126+ <Platforms>
127+ <Platform value="Linux64">True</Platform>
128+ <Platform value="Win32">True</Platform>
129+ <Platform value="Win64">False</Platform>
130+ </Platforms>
131+ </BorlandProject>
132+ <ProjectFileVersion>12</ProjectFileVersion>
133+ </ProjectExtensions>
134+ <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
135+ <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
136+</Project>
--- trunk/testes/ProjectGroup4.groupproj (nonexistent)
+++ trunk/testes/ProjectGroup4.groupproj (revision 43)
@@ -0,0 +1,36 @@
1+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
2+ <PropertyGroup>
3+ <ProjectGuid>{B978B39A-C6CD-4837-8BBD-1D4D0A892708}</ProjectGuid>
4+ </PropertyGroup>
5+ <ItemGroup>
6+ <Projects Include="Project6.dproj">
7+ <Dependencies/>
8+ </Projects>
9+ </ItemGroup>
10+ <ProjectExtensions>
11+ <Borland.Personality>Default.Personality.12</Borland.Personality>
12+ <Borland.ProjectType/>
13+ <BorlandProject>
14+ <Default.Personality/>
15+ </BorlandProject>
16+ </ProjectExtensions>
17+ <Target Name="Project6">
18+ <MSBuild Projects="Project6.dproj"/>
19+ </Target>
20+ <Target Name="Project6:Clean">
21+ <MSBuild Projects="Project6.dproj" Targets="Clean"/>
22+ </Target>
23+ <Target Name="Project6:Make">
24+ <MSBuild Projects="Project6.dproj" Targets="Make"/>
25+ </Target>
26+ <Target Name="Build">
27+ <CallTarget Targets="Project6"/>
28+ </Target>
29+ <Target Name="Clean">
30+ <CallTarget Targets="Project6:Clean"/>
31+ </Target>
32+ <Target Name="Make">
33+ <CallTarget Targets="Project6:Make"/>
34+ </Target>
35+ <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
36+</Project>
--- trunk/testes/Unit9.pas (nonexistent)
+++ trunk/testes/Unit9.pas (revision 43)
@@ -0,0 +1,1391 @@
1+unit Unit9;
2+
3+interface
4+
5+uses
6+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7+ Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw, Vcl.ExtCtrls, Vcl.ExtDlgs;
8+
9+type
10+ TAssignedProject = record
11+ Name: String;
12+ AccessLevel: String;
13+ Visibility: String;
14+ Description: String;
15+ end;
16+
17+ TAssignedProjects = array of TAssignedProject;
18+
19+ TUserInfo = record
20+ UserName: String;
21+ RealName: String;
22+ EMail: String;
23+ AccessLevel: String;
24+ ProjectAccessLevel: String;
25+ AssignedProjects: TAssignedProjects;
26+ end;
27+
28+ TTask = record
29+ Id: String;
30+ Status: String;
31+ StatusColor: TColor;
32+ Priority: String;
33+ Project: String;
34+ Description: String;
35+ Category: String;
36+ LastUpdate: TDateTime;
37+ AddCommentToken: String;
38+ MaxFileSize: Cardinal;
39+ end;
40+
41+ TAssignedTasks = array of TTask;
42+
43+ TStatusColor = record
44+ Id: Byte;
45+ Color: TColor;
46+ end;
47+
48+ TStatusColors = array of TStatusColor;
49+
50+ TForm9 = class(TForm)
51+ Button1: TButton;
52+ Button2: TButton;
53+ Memo1: TMemo;
54+ Button3: TButton;
55+ Button4: TButton;
56+ ColorListBox1: TColorListBox;
57+ Button5: TButton;
58+ Memo2: TMemo;
59+ OpenDialog1: TOpenDialog;
60+ procedure FormShow(Sender: TObject);
61+ procedure Button1Click(Sender: TObject);
62+ procedure Button2Click(Sender: TObject);
63+ procedure Button3Click(Sender: TObject);
64+ procedure Button4Click(Sender: TObject);
65+ procedure ColorListBox1GetColors(Sender: TCustomColorListBox;
66+ Items: TStrings);
67+ procedure Button5Click(Sender: TObject);
68+ private
69+ { Private declarations }
70+ FUserInfo: TUserInfo;
71+ FStatusColors: TStatusColors;
72+ public
73+ { Public declarations }
74+ end;
75+
76+var
77+ Form9: TForm9;
78+
79+implementation
80+
81+{$R *.dfm}
82+
83+uses
84+ KRK.Lib.Rtl.Win.WinInet.Utilities, KRK.Lib.Rtl.Common.FileUtils, EncdDecd, MSHTML, WinInet, NetEncoding, KRK.Lib.RegExp.Utils, {$if RTLVersion >= 22}RegularExpressionsCore{$else}KRK.Lib.RegExp.PerlRegEx{$ifend};
85+
86+const
87+ BASE_URL = 'https://desenvolvimento.tjpe.gov.br';
88+
89+//function GetCookies: boolean;
90+//var
91+// h:THandle;
92+// dwEntrySize:DWORD;
93+// LPCacheEntry:^TInternetCacheEntryInfoA;
94+// MAX_CACHE_ENTRY_INFO_SIZE:DWORD;
95+// flag:boolean;
96+// s:LPSTR;
97+// aStr:String;
98+// Size:DWORD;
99+// lpszData:LPSTR;
100+// Res:boolean;
101+//begin
102+// MAX_CACHE_ENTRY_INFO_SIZE := 4096;
103+// dwEntrySize := MAX_CACHE_ENTRY_INFO_SIZE;
104+//
105+// GetMem(lpCacheEntry,8 * dwEntrySize);
106+//
107+// lpCacheEntry.dwStructSize := dwEntrySize;
108+//
109+// h := FindFirstUrlCacheEntryA('cookie:',lpCacheEntry^,dwEntrySize);
110+//
111+// if h=0 then
112+// begin
113+// FreeMem(lpCacheEntry);
114+// Result := false;
115+// Exit;
116+// end;
117+//
118+// flag := true;
119+//
120+// while flag do
121+// begin
122+// if (lpCacheEntry.CacheEntryType and COOKIE_CACHE_ENTRY) <> 0 then
123+// begin
124+// s:=lpCacheEntry.lpszSourceUrlName;
125+// lpszData:=nil;
126+// Size:=0;
127+// Res := InternetGetCookieA(s,nil,lpszData,Size);// this line don't work :
128+// //Size== 0,lpszData == nil
129+// //Res==false
130+// end;
131+//
132+// FreeMem(lpCacheEntry);
133+//
134+// dwEntrySize:=MAX_CACHE_ENTRY_INFO_SIZE;
135+// GetMem(lpCacheEntry,8*dwEntrySize);
136+// lpCacheEntry.dwStructSize:=dwEntrySize;
137+// flag:=FindNextUrlCacheEntryA(h,lpCacheEntry^,dwEntrySize);
138+// end;
139+// FreeMem(lpCacheEntry);
140+// FindCloseUrlCache(h);
141+//
142+//end;
143+
144+{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
145+function UserInfo(AHandle: Cardinal; out AUserInfo: TUserInfo): Boolean;
146+var
147+ Req: TRequestOptions;
148+ Res: TResponse;
149+ HTD: OleVariant;
150+ i: Word;
151+ ELE: OleVariant;
152+begin
153+ ZeroMemory(@Req,SizeOf(Req));
154+ ZeroMemory(@Res,SizeOf(Res));
155+ ZeroMemory(@AUserInfo,SizeOf(TUserInfo));
156+
157+ Req.AutoClearSSLState := True;
158+
159+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
160+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
161+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/account_page.php';
162+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
163+ Req.InternetConnectParams.Context := AHandle;
164+
165+ Req.HttpOpenRequestParams.Verb := 'GET';
166+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
167+ try
168+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
169+ Req.HttpOpenRequestParams.Context := AHandle;
170+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
171+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
172+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
173+
174+ Res.Content := TStringStream.Create('');
175+ try
176+ Request(Req,Res);
177+
178+ HTD := coHTMLDocument.Create as IHTMLDocument2;
179+
180+ // Habilita o modo de design, o qual desabilita scripts e permite a
181+ // leitura do código da página exatamente como ele é. Scripts podem
182+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
183+ // ser diferente daquilo que ele seria ao não usar esta propriedade
184+ HTD.designMode := 'On';
185+ HTD.Write(TStringStream(Res.Content).DataString);
186+ HTD.close;
187+
188+ ELE := HTD.getElementById('email-field');
189+
190+ Result := not VarIsClear(ELE);
191+
192+ if Result then
193+ begin
194+ AUserInfo.EMail := ELE.Value;
195+ AUserInfo.RealName := UTF8ToString(HTD.getElementById('realname').Value);
196+ AUserInfo.UserName := HTD.getElementsByTagName('td').item(1).innerText;
197+ AUserInfo.AccessLevel := HTD.getElementsByTagName('td').item(13).innerText;
198+ AUserInfo.ProjectAccessLevel := HTD.getElementsByTagName('td').item(15).innerText;
199+
200+ for i := 0 to HTD.body.all.length - 1 do
201+ begin
202+ ELE := HTD.body.all.item(i);
203+
204+ if (LowerCase(ELE.tagName) = 'table') and (LowerCase(ELE.className) = 'table table-striped table-bordered table-condensed table-hover') then
205+ Break;
206+ end;
207+
208+ // Se achou algo, saiu do loop prematuramente, logo, é isso que precisamos
209+ // testar para saber se achou algo
210+ if i < HTD.body.all.Length then
211+ begin
212+ ELE := ELE.getElementsByTagName('tr');
213+
214+ SetLength(AUserInfo.AssignedProjects,Integer(ELE.length - 1));
215+
216+ for i := 1 to ELE.length - 1 do // O elemento zero é um TH
217+ begin
218+ AUserInfo.AssignedProjects[i-1].Name := UTF8ToString(ELE.item(i).all.item(0).innerText);
219+ AUserInfo.AssignedProjects[i-1].AccessLevel := ELE.item(i).all.item(1).innerText;
220+ AUserInfo.AssignedProjects[i-1].Visibility := ELE.item(i).all.item(2).innerText;
221+ AUserInfo.AssignedProjects[i-1].Description := UTF8ToString(ELE.item(i).all.item(3).innerText);
222+ end;
223+ end;
224+
225+ end;
226+ finally
227+ Res.Content.Free;
228+ end;
229+ finally
230+ Req.HttpOpenRequestParams.AcceptTypes.Free;
231+ end;
232+end;
233+{$WARN IMPLICIT_STRING_CAST_LOSS ON}
234+
235+procedure StatusColors(AHandle: Cardinal; out AStatusColors: TStatusColors);
236+var
237+ Req: TRequestOptions;
238+ Res: TResponse;
239+ Aux: String;
240+ i: Word;
241+begin
242+ ZeroMemory(@Req,SizeOf(Req));
243+ ZeroMemory(@Res,SizeOf(Res));
244+
245+ Req.AutoClearSSLState := True;
246+
247+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
248+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
249+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/css/status_config.php';
250+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
251+ Req.InternetConnectParams.Context := AHandle;
252+
253+ Req.HttpOpenRequestParams.Verb := 'GET';
254+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
255+ try
256+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
257+ Req.HttpOpenRequestParams.Context := AHandle;
258+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
259+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
260+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
261+
262+ Res.Content := TStringStream.Create('');
263+ try
264+ Request(Req,Res);
265+
266+ with TStringList.Create do
267+ try
268+ RegExMatch(TStringStream(Res.Content).DataString
269+ ,'\.status-(\d{2})-color\s*{\s*color:\s*#([[:xdigit:]]+);\s*background-color:\s*#([[:xdigit:]]+);\s*}'
270+ ,1
271+ ,0
272+ ,False
273+ ,[]
274+ ,Aux);
275+
276+ StrictDelimiter := True;
277+ Delimiter := ';';
278+ DelimitedText := Aux;
279+
280+ SetLength(AStatusColors,Count);
281+
282+ for i := 0 to Pred(Count) do
283+ AStatusColors[i].Id := Strings[i].ToInteger;
284+
285+ RegExMatch(TStringStream(Res.Content).DataString
286+ ,'\.status-(\d{2})-color\s*{\s*color:\s*#([[:xdigit:]]+);\s*background-color:\s*#([[:xdigit:]]+);\s*}'
287+ ,2
288+ ,0
289+ ,False
290+ ,[]
291+ ,Aux);
292+
293+ DelimitedText := Aux;
294+
295+ for i := 0 to Pred(Count) do
296+ AStatusColors[i].Color := RGB(StrToInt('$' + Copy(Strings[i],1,2))
297+ ,StrToInt('$' + Copy(Strings[i],3,2))
298+ ,StrToInt('$' + Copy(Strings[i],5,2)));
299+
300+
301+ finally
302+ Free;
303+ end;
304+ finally
305+ Res.Content.Free;
306+ end;
307+ finally
308+ Req.HttpOpenRequestParams.AcceptTypes.Free;
309+ end;
310+end;
311+
312+function DecodeStatusColor(AStatusColors: TStatusColors; AClassName: String): TColor;
313+var
314+ StatusCode: String;
315+ i: Byte;
316+begin
317+ Result := clNone;
318+
319+ // Usa um negative lookahead na expressão regular para achar a última
320+ // ocorrência de uma classe que define a cor do status
321+ if RegExMatch(AClassName,'status-(\d{2})-color(?!.*status-\d{2}-color)',1,1,False,[],StatusCode) then
322+ for i := 0 to High(AStatusColors) do
323+ if AStatusColors[i].id = StatusCode.ToInteger then
324+ begin
325+ Result := AStatusColors[i].Color;
326+ Break;
327+ end;
328+end;
329+
330+function FixEncoding(AText: OleVariant): String;
331+begin
332+ Result := UTF8ToString(RawByteString(AText));
333+end;
334+
335+function ExtractProjectName(AString: OleVariant): String;
336+begin
337+ RegExReplaceAll(AString,'\[(.*)\]','\1',Result);
338+end;
339+
340+function ExtractDateTime(AString: OleVariant): TDateTime;
341+var
342+ DateTime: String;
343+begin
344+ Result := 0;
345+
346+ if RegExReplaceAll(AString,'.*(\d{4})-(\d{2})-(\d{2}) (\d{2}:\d{2})','\3/\2/\1 \4',DateTime) then
347+ Result := StrToDateTime(DateTime);
348+end;
349+
350+function AssignedTasks(AHandle: Cardinal; AStatusColors: TStatusColors; out AAssignedTasks: TAssignedTasks): Boolean;
351+var
352+ Req: TRequestOptions;
353+ Res: TResponse;
354+ HTMLDocument: OleVariant;
355+ AssignedTasks: OleVariant;
356+ i: Word;
357+begin
358+ Result := False;
359+ ZeroMemory(@Req,SizeOf(Req));
360+ ZeroMemory(@Res,SizeOf(Res));
361+
362+ Req.AutoClearSSLState := True;
363+
364+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
365+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
366+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/my_view_page.php';
367+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
368+ Req.InternetConnectParams.Context := AHandle;
369+
370+ Req.HttpOpenRequestParams.Verb := 'GET';
371+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
372+ try
373+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
374+ Req.HttpOpenRequestParams.Context := AHandle;
375+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
376+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
377+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
378+
379+ Res.Content := TStringStream.Create('');
380+ try
381+ Request(Req,Res);
382+
383+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
384+
385+ // Habilita o modo de design, o qual desabilita scripts e permite a
386+ // leitura do código da página exatamente como ele é. Scripts podem
387+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
388+ // ser diferente daquilo que ele seria ao não usar esta propriedade
389+ HTMLDocument.DesignMode := 'On';
390+ HTMLDocument.Write(TStringStream(Res.Content).DataString);
391+ HTMLDocument.Close;
392+
393+ try
394+ Result := UTF8ToString(RawByteString(HTMLDocument.getElementsByTagName('h4').Item(0).ChildNodes[1].InnerText)) = 'Atribuídos a Mim (não resolvidos)';
395+ except
396+ { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
397+ texto correto, mas pdoe ser que haja um access violation e por isso, o
398+ result tem que permanecer false. Usando o mudinho, mantemos o result
399+ como false, mas não levantamos qualquer exceção }
400+ end;
401+
402+ if Result then
403+ begin
404+ // A atribuição a uma variável ajuda a reduzir o tamanho da expressão,
405+ // no etanto se perde a capacidade de usar [] para acessar itens de
406+ // coleções. Mais adiante, dentro do for, usa-se AssignedTasks.Item(i),
407+ // ao invés de AssignedTasks[i], porque não é possível ou não consegui
408+ // achar um modo de realizar um cast
409+ AssignedTasks := HTMLDocument.getElementsByTagName('tbody').Item(0).ChildNodes;
410+
411+ SetLength(AAssignedTasks,Integer(AssignedTasks.Length));
412+
413+ for i := 0 to AssignedTasks.Length - 1 do
414+ begin
415+ AAssignedTasks[i].Id := AssignedTasks.Item(i).ChildNodes[0].ChildNodes[0].InnerText;
416+ AAssignedTasks[i].Status := FixEncoding(AssignedTasks.Item(i).ChildNodes[0].ChildNodes[2].Title);
417+ AAssignedTasks[i].StatusColor := DecodeStatusColor(AStatusColors,AssignedTasks.Item(i).ChildNodes[0].ChildNodes[2].ClassName);
418+ AAssignedTasks[i].Priority := FixEncoding(AssignedTasks.Item(i).ChildNodes[0].ChildNodes[4].Title);
419+ AAssignedTasks[i].Project := FixEncoding(ExtractProjectName(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[0].InnerText));
420+ AAssignedTasks[i].Description := FixEncoding(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[1].ChildNodes[0].InnerText);
421+ AAssignedTasks[i].Category := FixEncoding(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[3].InnerText);
422+ AAssignedTasks[i].LastUpdate := ExtractDateTime(AssignedTasks.Item(i).ChildNodes[1].ChildNodes[4].InnerText);
423+ end;
424+
425+ end;
426+ finally
427+ Res.Content.Free;
428+ end;
429+ finally
430+ Req.HttpOpenRequestParams.AcceptTypes.Free;
431+ end;
432+end;
433+
434+function Login(AHandle: Cardinal; AUserName: String; APassword: String; out AUserInfo: TUserInfo): Boolean;
435+var
436+ Req: TRequestOptions;
437+ Res: TResponse;
438+ Aux: String;
439+begin
440+ ZeroMemory(@Req,SizeOf(Req));
441+ ZeroMemory(@Res,SizeOf(Res));
442+ ZeroMemory(@AUserInfo,SizeOf(TUserInfo));
443+
444+ Req.AutoClearSSLState := True;
445+
446+ Req.Content := TStringStream.Create(Format('return=index.php&username=%s&password=%s&perm_login=on',[AUserName,APassword]));
447+ try
448+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
449+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
450+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/login.php';
451+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
452+ Req.InternetConnectParams.Context := AHandle;
453+
454+ Req.HttpOpenRequestParams.Verb := 'POST';
455+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
456+ try
457+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
458+ Req.HttpOpenRequestParams.Context := AHandle;
459+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
460+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
461+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
462+ try
463+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: application/x-www-form-urlencoded');
464+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
465+
466+ Res.Content := TStringStream.Create('');
467+ try
468+ Request(Req,Res);
469+
470+ Result := RegExMatch(TStringStream(Res.Content).DataString
471+ ,'<a href="\/mantis\/account_page\.php">\s*([a-z]*)\s*\(\s*(.*)\s*\)\s*<\/a>'
472+ ,0
473+ ,0
474+ ,False
475+ ,[]
476+ ,Aux);
477+ if Result then
478+ Result := UserInfo(AHandle,AUserInfo);
479+ finally
480+ Res.Content.Free;
481+ end;
482+ finally
483+ Req.HttpOpenRequestParams.Headers.Free;
484+ end;
485+ finally
486+ Req.HttpOpenRequestParams.AcceptTypes.Free;
487+ end;
488+ finally
489+ Req.Content.Free;
490+ end;
491+end;
492+
493+function TaskDetails(AHandle: Cardinal; var ATask: TTask): Boolean;
494+var
495+ Req: TRequestOptions;
496+ Res: TResponse;
497+ HTMLDocument: OleVariant;
498+ Inputs: OleVariant;
499+ i: Word;
500+begin
501+ Result := False;
502+ ZeroMemory(@Req,SizeOf(Req));
503+ ZeroMemory(@Res,SizeOf(Res));
504+
505+ Req.AutoClearSSLState := True;
506+
507+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
508+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
509+ Req.InternetConnectParams.ServerName := PChar(BASE_URL + '/mantis/view.php?id=' + ATask.Id);
510+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
511+ Req.InternetConnectParams.Context := AHandle;
512+
513+ Req.HttpOpenRequestParams.Verb := 'GET';
514+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
515+ try
516+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
517+ Req.HttpOpenRequestParams.Context := AHandle;
518+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
519+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
520+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
521+
522+ Res.Content := TStringStream.Create('');
523+ try
524+ Request(Req,Res);
525+
526+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
527+
528+ // Habilita o modo de design, o qual desabilita scripts e permite a
529+ // leitura do código da página exatamente como ele é. Scripts podem
530+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
531+ // ser diferente daquilo que ele seria ao não usar esta propriedade
532+ HTMLDocument.DesignMode := 'On';
533+ HTMLDocument.Write(TStringStream(Res.Content).DataString);
534+ HTMLDocument.Close;
535+
536+ try
537+ Result := FixEncoding(HTMLDocument.getElementsByTagName('h4').Item(0).InnerText) = 'Ver Detalhes da Tarefa';
538+ except
539+ { É um mudinho de propósito. A idéia aqui é verificar se há o tag com o
540+ texto correto, mas pdoe ser que haja um access violation e por isso, o
541+ result tem que permanecer false. Usando o mudinho, mantemos o result
542+ como false, mas não levantamos qualquer exceção }
543+ end;
544+
545+ if Result then
546+ begin
547+ Inputs := HTMLDocument.GetElementById('bugnoteadd').GetElementsByTagName('input');
548+
549+ for i := 0 to Inputs.Length - 1 do
550+ begin
551+ if Inputs.Item(i).Name = 'bugnote_add_token' then
552+ ATask.AddCommentToken := Inputs.Item(i).Value
553+ else if Inputs.Item(i).Name = 'max_file_size' then
554+ ATask.MaxFileSize := Inputs.Item(i).Value;
555+ end;
556+ end;
557+ finally
558+ Res.Content.Free;
559+ end;
560+ finally
561+ Req.HttpOpenRequestParams.AcceptTypes.Free;
562+ end;
563+end;
564+
565+
566+
567+procedure WriteStream(AStream: TStream; AValue: RawByteString);
568+var
569+ i: Cardinal;
570+begin
571+ for i := 1 to Length(AValue) do
572+ AStream.Write(AValue[i],1);
573+end;
574+
575+// Antes de chamar este procedure, garanta que o stream está na posição correta
576+procedure AddTextMultiPartFormData(ARequestStream: TMemoryStream; AContentDisposition: UTF8String; AName: UTF8String; AContent: UTF8String; ABoundary: UTF8String; AContentType: UTF8String = ''; ALastPart: Boolean = False);
577+var
578+ Aux: RawByteString;
579+begin
580+ // Monta o cabeçalho da parte, juntamente com seu conteúdo e escreve no stream
581+ Aux := '--' + ABoundary + #13#10
582+ + 'Content-Disposition: ' + AContentDisposition + '; name="' + AName + '"'#13#10;
583+
584+ if AContentType <> '' then
585+ Aux := Aux + 'Content-Type: ' + AContentType + #13#10;
586+
587+ Aux := Aux + #13#10;
588+ Aux := Aux + AContent + #13#10;
589+
590+ WriteStream(ARequestStream,Aux);
591+
592+ // Caso esta seja a última parte, grava no stream o boundary finalizador
593+ if ALastPart then
594+ begin
595+ Aux := '--' + ABoundary + '--';
596+ WriteStream(ARequestStream,Aux);
597+ end;
598+end;
599+
600+procedure AddFileMultiPartFormData(ARequestStream: TMemoryStream; AContentDisposition: UTF8String; AName: UTF8String; AFileName: TFileName; ABoundary: UTF8String; ALastPart: Boolean = False);
601+var
602+ Aux: RawByteString;
603+ FileStream: TFileStream;
604+begin
605+ if not FileExists(AFileName) then
606+ raise Exception.Create('Arquivo inexistente!');
607+
608+ // Monta o cabeçalho da parte e escreve no stream
609+ Aux := '--' + ABoundary + #13#10
610+ + 'Content-Disposition: ' + AContentDisposition + '; name="' + AName + '"; filename="' + UTF8String(ExtractFileName(AFileName)) + '"'#13#10
611+ + 'Content-Type: ' + GetFileMIMEType(AFileName) + #13#10#13#10;
612+
613+ WriteStream(ARequestStream,Aux);
614+
615+ // Copia os bytes do arquivo, escrevendo os no stream
616+ FileStream := TFileStream.Create(AFileName,fmOpenRead);
617+ try
618+ ARequestStream.CopyFrom(FileStream,FileStream.Size);
619+ WriteStream(ARequestStream,#13#10);
620+ finally
621+ FileStream.Free;
622+ end;
623+
624+ // Caso esta seja a última parte, grava no stream o boundary finalizador
625+ if ALastPart then
626+ begin
627+ Aux := '--' + ABoundary + '--';
628+ WriteStream(ARequestStream,Aux);
629+ end;
630+end;
631+
632+//uma propriedade para receber cada arquivo e cada um de seus mimes
633+function AddComment(AHandle: Cardinal; AAddCommentToken: UTF8String; AMaxFileSize: Cardinal; ATaskId: Cardinal; AComment: UTF8String; AAttachments: array of String; out AError: String): Boolean;
634+var
635+ Req: TRequestOptions;
636+ Res: TResponse;
637+ Boundary: UTF8String;
638+ i: Word;
639+ HTMLDocument: OleVariant;
640+ Divs: OleVariant;
641+begin
642+ AError := '';
643+ ZeroMemory(@Req,SizeOf(Req));
644+ ZeroMemory(@Res,SizeOf(Res));
645+
646+ Req.AutoClearSSLState := True;
647+
648+ Boundary := 'MantisMonitor-2A57FA77-3372-47B1-B365-5C9F38ACF786';
649+
650+ Req.Content := TMemoryStream.Create; // TStringStream.Create(ReqContents)
651+ try
652+
653+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bugnote_add_token',AAddCommentToken,Boundary);
654+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bug_id',UTF8String(ATaskId.ToString),Boundary);
655+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','bugnote_text',AComment,Boundary);
656+
657+ if Length(AAttachments) = 0 then
658+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','max_file_size',UTF8String(IntToStr(AMaxFileSize)),Boundary,'',True)
659+ else
660+ begin
661+ AddTextMultiPartFormData(TMemoryStream(Req.Content),'form-data','max_file_size',UTF8String(IntToStr(AMaxFileSize)),Boundary);
662+
663+ for i := 0 to High(AAttachments) do
664+ AddFileMultiPartFormData(TMemoryStream(Req.Content),'form-data',UTF8String('ufile[' + IntToStr(i) + ']'),AAttachments[i],Boundary,i = High(AAttachments));
665+ end;
666+
667+ Req.InternetOpenParams.Agent := 'Mantis Monitor';
668+ Req.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
669+ Req.InternetConnectParams.ServerName := BASE_URL + '/mantis/bugnote_add.php';
670+ Req.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
671+ Req.InternetConnectParams.Context := AHandle;
672+
673+ Req.HttpOpenRequestParams.Verb := 'POST';
674+ Req.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
675+ try
676+ Req.HttpOpenRequestParams.AcceptTypes.Add('*/*');
677+ Req.HttpOpenRequestParams.Context := AHandle;
678+ Req.HttpOpenRequestParams.AutoDetectHTTPS := True;
679+ Req.HttpOpenRequestParams.IgnoreInvalidCertificates := True;
680+ Req.HttpOpenRequestParams.Headers := TStringList.Create;
681+ try
682+ Req.HttpOpenRequestParams.Headers.Add('Content-Type: multipart/form-data; boundary=' + String(Boundary));
683+ Req.HttpSendRequestParams.IgnoreInvalidCertificateCA := True;
684+
685+ Res.Content := TStringStream.Create('');
686+ try
687+ Request(Req,Res);
688+
689+ HTMLDocument := coHTMLDocument.Create as IHTMLDocument2;
690+
691+ // Habilita o modo de design, o qual desabilita scripts e permite a
692+ // leitura do código da página exatamente como ele é. Scripts podem
693+ // modificar o DOM, logo, ao usar esta propriedade o texto parseado pode
694+ // ser diferente daquilo que ele seria ao não usar esta propriedade
695+ HTMLDocument.DesignMode := 'On';
696+ HTMLDocument.Write(TStringStream(Res.Content).DataString);
697+ HTMLDocument.Close;
698+
699+ Divs := HTMLDocument.GetElementsByTagName('div');
700+
701+ for i := 0 to Divs.Length - 1 do
702+ begin
703+ if Divs.Item(i).ClassName = 'alert alert-danger' then
704+ begin
705+ AError := UTF8ToString(RawByteString(Divs.Item(i).ChildNodes[0].InnerText + '|' + Divs.Item(i).ChildNodes[1].InnerText));
706+ Break;
707+ end;
708+ end;
709+
710+ // Caso tenha saído do loop anterior prematuramente, significa que
711+ // houve um erro
712+ Result := i = Divs.Length;
713+
714+
715+
716+
717+
718+
719+// Res.Content.Position := 0;
720+// FORM9.Memo1.Lines.LoadFromStream(Res.Content);
721+
722+// Result := RegExMatch(TStringStream(Res.Content).DataString
723+// ,'<a href="\/mantis\/account_page\.php">\s*([a-z]*)\s*\(\s*(.*)\s*\)\s*<\/a>'
724+// ,0
725+// ,0
726+// ,False
727+// ,[]
728+// ,Aux);
729+// if Result then
730+// Result := UserInfo(AHandle,AUserInfo);
731+ finally
732+ Res.Content.Free;
733+ end;
734+ finally
735+ Req.HttpOpenRequestParams.Headers.Free;
736+ end;
737+ finally
738+ Req.HttpOpenRequestParams.AcceptTypes.Free;
739+ end;
740+ finally
741+ Req.Content.Free;
742+ end;
743+end;
744+(*
745+ ZeroMemory(@RO,SizeOf(RO));
746+ ZeroMemory(@RE,SizeOf(RE));
747+
748+ MEMOResponse.Clear;
749+
750+ RO.AutoClearSSLState := True;
751+
752+ RO.Content := nil;
753+ if CHBXUseRequestContent.Checked then
754+ begin
755+ if CHBXFileUpload.Checked then
756+ begin
757+ with TStringList.Create do
758+ try
759+ LoadFromFile('D:\35180401158586000180570010000016131000016137-cte.xml');
760+ RO.Content := TStringStream.Create(Trim(Text));
761+ finally
762+ Free;
763+ end;
764+ end
765+ else
766+ RO.Content := TStringStream.Create(Trim(MEMORequest.Text));
767+ end;
768+
769+ RO.MaximumSingleRequestContentSize := StrToInt(LAEDMaximumSingleRequestContentSize.Text); // Ao usar zero, na verdade será usado o valor padrão = High(SmallInt)
770+ { InternetOpen }
771+ RO.InternetOpenParams.Agent := 'Anak Krakatoa Delphi Library';
772+ RO.InternetOpenParams.AccessType := INTERNET_OPEN_TYPE_PRECONFIG;
773+ RO.InternetOpenParams.ProxyName := nil;
774+ RO.InternetOpenParams.ProxyBypass := nil;
775+ RO.InternetOpenParams.Flags := 0;
776+ { InternetConnect }
777+ RO.InternetConnectParams.ServerName := PChar(CBBXURL.Text);
778+
779+ RO.InternetConnectParams.UserName := nil;
780+ if LAEDUserName.Text <> '' then
781+ RO.InternetConnectParams.UserName := PChar(LAEDUserName.Text);
782+
783+ RO.InternetConnectParams.Password := nil;
784+ if LAEDPassword.Text <> '' then
785+ RO.InternetConnectParams.Password := PChar(LAEDPassword.Text);
786+
787+ RO.InternetConnectParams.Service := INTERNET_SERVICE_HTTP;
788+ RO.InternetConnectParams.Flags := 0;
789+ RO.InternetConnectParams.Context := Self.Handle;
790+ { HttpOpenRequest }
791+ RO.HttpOpenRequestParams.Verb := PChar(CBBXVerb.Text);
792+ RO.HttpOpenRequestParams.ObjectName := nil;
793+ RO.HttpOpenRequestParams.Version := nil;
794+ RO.HttpOpenRequestParams.Referrer := nil;
795+ RO.HttpOpenRequestParams.ConnectTimeout := StrToInt(LAEDConnectTimeOut.Text);
796+ RO.HttpOpenRequestParams.SendTimeout := StrToInt(LAEDSendTimeOut.Text);
797+ RO.HttpOpenRequestParams.ReceiveTimeout := StrToInt(LAEDReceiveTimeOut.Text);
798+
799+ RO.HttpOpenRequestParams.AcceptTypes := nil;
800+ if CHBXUseAcceptTypes.Checked then
801+ begin
802+ RO.HttpOpenRequestParams.AcceptTypes := TStringList.Create;
803+ RO.HttpOpenRequestParams.AcceptTypes.Text := Trim(MEMOAcceptTypes.Text);
804+ end;
805+
806+ RO.HttpOpenRequestParams.Flags := 0;
807+ RO.HttpOpenRequestParams.Context := Self.Handle;
808+ { HttpOpenRequest (extras) }
809+ RO.HttpOpenRequestParams.AutoDetectHTTPS := CHBXHTTPSAutoDetect.Checked; // adiciona automaticamente INTERNET_FLAG_SECURE para conexões com https
810+ RO.HttpOpenRequestParams.IgnoreInvalidCertificates := CHBXIgnoreInvalidCertificates.Checked; // Adiciona automaticamente INTERNET_FLAG_IGNORE_CERT_CN_INVALID + INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
811+
812+ RO.HttpOpenRequestParams.Headers := nil; // Executa HttpAddRequestHeaders para cada header da lista
813+ if CHBXUseOpenRequestHeaders.Checked then
814+ begin
815+ RO.HttpOpenRequestParams.Headers := TStringList.Create;
816+ RO.HttpOpenRequestParams.Headers.Text := Trim(MEMOOpenRequestHeaders.Text);
817+ end;
818+
819+ { HttpSendRequest }
820+ RO.HttpSendRequestParams.Headers := nil; // Substitui cada quebra de linha da lista por \r\n e atribui o texto resultante no parâmetro Headers de HttpSendRequest
821+ if CHBXUseSendRequestHeaders.Checked then
822+ begin
823+ RO.HttpSendRequestParams.Headers := TStringList.Create;
824+ RO.HttpSendRequestParams.Headers.Text := Trim(MEMOSendRequestHeaders.Text);
825+ end;
826+
827+ RO.HttpSendRequestParams.Optional := nil;
828+ RO.HttpSendRequestParams.OptionalLength := 0;
829+ { HttpSendRequest (extras) }
830+ RO.HttpSendRequestParams.IgnoreInvalidCertificateCA := CHBXIgnoreInvalidCertsCA.Checked;
831+ RO.HttpSendRequestParams.UseCustomCertificateSelection := CHBXUseCustomCertificateSelection.Checked; // Usa o seletor de certificados customizado, cujos parâmetros estão logo abaixo
832+ RO.HttpSendRequestParams.OnBeforeHttpSendRequest := nil;
833+ RO.HttpSendRequestParams.OnHttpSendRequestError := nil;
834+ RO.HttpSendRequestParams.OnSendingData := nil;
835+ RO.HttpSendRequestParams.OnReceivingData := nil;
836+ { SelectCertificate }
837+ RO.HttpSendRequestParams.SelectCertificateParams.CertificateStore := TCertificateStore(CBBXCertificateStore.ItemIndex);
838+ RO.HttpSendRequestParams.SelectCertificateParams.CSPName := EDITCSPName.Text;
839+ RO.HttpSendRequestParams.SelectCertificateParams.ProviderTypeId := StrToInt(EDITProviderTypeId.Text);
840+ RO.HttpSendRequestParams.SelectCertificateParams.SelectDialogTitle := EDITSelectDialogTitle.Text;
841+ RO.HttpSendRequestParams.SelectCertificateParams.SelectDialogDescription := EDITSelectDialogDescription.Text;
842+ RO.HttpSendRequestParams.SelectCertificateParams.SystemStoreName := CBBXSubsystemProtocol.Text;
843+ RO.HttpSendRequestParams.SelectCertificateParams.CertificateFile := EDITCertificateFile.Text;
844+ RO.HttpSendRequestParams.SelectCertificateParams.CertificatePassword := EDITCertificatePassword.Text;
845+ RO.HttpSendRequestParams.SelectCertificateParams.WindowHandle := Self.Handle;
846+
847+
848+ RE.Content := TStringStream.Create('');
849+ try
850+ Request(RO, RE);
851+ if Pos('Content-Type: text/xml',RE.Headers) > 0 then
852+ MEMOResponse.Text := FormatXMLFile(TStringStream(RE.Content).DataString)
853+ else
854+ MEMOResponse.Text := TStringStream(RE.Content).DataString;
855+ MEMOHeaders.Text := RE.Headers;
856+ finally
857+ RE.Content.Free;
858+ RO.HttpSendRequestParams.Headers.Free;
859+ RO.HttpOpenRequestParams.Headers.Free;
860+ RO.HttpOpenRequestParams.AcceptTypes.Free;
861+ RO.Content.Free;
862+ end;
863+
864+
865+*)
866+
867+
868+//function RegExMatch(ASubject, APattern: String; AGroup: Byte; out AMatch: String): Boolean;
869+//begin
870+// Result := False;
871+// AMatch := '';
872+//
873+// with TPerlRegEx.Create do
874+// try
875+// Subject := ASubject;
876+// RegEx := APattern;
877+// if Match then
878+// begin
879+// Result := True;
880+//
881+// if AGroup > 0 then
882+// repeat
883+// if AMatch = '' then
884+// AMatch := Groups[AGroup]
885+// else
886+// AMatch := AMatch + ';' + Groups[AGroup];
887+// until not MatchAgain
888+// else
889+// repeat
890+// if AMatch = '' then
891+// AMatch := MatchedText
892+// else
893+// AMatch := AMatch + ';' + MatchedText;
894+// until not MatchAgain
895+// end;
896+// finally
897+// Free;
898+// end;
899+//end;
900+
901+//function RegExReplaceAll(ASubject, APattern, AReplacement: String; out AResult: String; ASingleLine: Boolean = True; ACaseInsensitive: Boolean = True): Boolean;
902+//begin
903+// Result := False;
904+// AResult := '';
905+//
906+// with TPerlRegEx.Create do
907+// try
908+// if ASingleLine then
909+// Options := Options + [preSingleLine];
910+// if ACaseInsensitive then
911+// Options := Options + [preCaseLess];
912+//
913+// Subject := ASubject;
914+// RegEx := APattern;
915+// Replacement := AReplacement;
916+// if ReplaceAll then
917+// begin
918+// AResult := Subject;
919+// Result := True;
920+// end;
921+// finally
922+// Free;
923+// end;
924+//end;
925+
926+// Protege AProtectPattern enquanto realiza a substituição de AOldPattern por
927+// AReplacement, colocando o resultado final em AResult
928+function RegExProtectAndReplace(ASubject, AProtectPattern, AOldPattern, AReplacement: String; AProtectedSingleLine: Boolean = True; AProtectedCaseInsensitive: Boolean = True; AReplaceSingleLine: Boolean = True; AReplaceCaseInsensitive: Boolean = True): String;
929+const
930+ PROTECTEDPLACEHOLDER = '[¯:_:¯]';
931+var
932+ ProtectedTexts: array of string;
933+// -----------------------------------------------------------------------------
934+// Protege o texto substituindo cada ocorrência de APattern por <:protected:> e
935+// salva o texto substitído no array AProtectedTexts
936+function Protect: String;
937+begin
938+ Result := ASubject;
939+
940+ with TPerlRegEx.Create do
941+ try
942+ if AProtectedSingleLine then
943+ Options := Options + [preSingleLine];
944+ if AProtectedCaseInsensitive then
945+ Options := Options + [preCaseLess];
946+
947+ Subject := Result;
948+ RegEx := AProtectPattern;
949+ Replacement := PROTECTEDPLACEHOLDER;
950+
951+ if Match then
952+ begin
953+ repeat
954+ SetLength(ProtectedTexts,Length(ProtectedTexts) + 1);
955+ ProtectedTexts[High(ProtectedTexts)] := MatchedText;
956+ Replace
957+ until not MatchAgain;
958+ end;
959+ Result := Subject;
960+ finally
961+ Free;
962+ end;
963+end;
964+
965+function Replace: String;
966+begin
967+ Result := ASubject;
968+
969+ with TPerlRegEx.Create do
970+ try
971+ if AReplaceSingleLine then
972+ Options := Options + [preSingleLine];
973+ if AReplaceCaseInsensitive then
974+ Options := Options + [preCaseLess];
975+
976+ Subject := Result;
977+ RegEx := AOldPattern;
978+ Replacement := AReplacement;
979+
980+ ReplaceAll;
981+
982+ Result := Subject;
983+ finally
984+ Free;
985+ end;
986+end;
987+
988+function RecoverProtected: String;
989+var
990+ i: Word;
991+begin
992+ Result := ASubject;
993+
994+ i := 0;
995+ while Pos(PROTECTEDPLACEHOLDER,Result) > 0 do
996+ begin
997+ Result := StringReplace(Result,PROTECTEDPLACEHOLDER,ProtectedTexts[i],[]);
998+ Inc(i);
999+ end;
1000+end;
1001+//// -----------------------------------------------------------------------------
1002+begin
1003+ ASubject := Protect;
1004+ ASubject := Replace;
1005+ Result := RecoverProtected;
1006+end;
1007+
1008+(*
1009+
1010+ function string_display( $p_string ) {
1011+ $p_string = string_strip_hrefs( $p_string );
1012+ $p_string = string_html_specialchars( $p_string );
1013+ $p_string = string_restore_valid_html_tags( $p_string, /* multiline = */ true );
1014+ $p_string = string_preserve_spaces_at_bol( $p_string );
1015+ $p_string = string_nl2br( $p_string );
1016+
1017+ return $p_string;
1018+ }
1019+
1020+ function string_display_links( $p_string ) {
1021+ $p_string = string_display( $p_string );
1022+ $p_string = string_insert_hrefs( $p_string );
1023+ $p_string = string_process_bug_link( $p_string );
1024+ $p_string = string_process_bugnote_link( $p_string );
1025+ $p_string = string_process_cvs_link( $p_string );
1026+
1027+ return $p_string;
1028+ }
1029+
1030+
1031+*)
1032+
1033+{$WARNINGS OFF}
1034+procedure TForm9.Button1Click(Sender: TObject);
1035+var
1036+ AP: TAssignedProject;
1037+begin
1038+ if Login(Self.Handle,'cbff','d1d2f3b4',FUserInfo) then
1039+
1040+ Memo1.Clear;
1041+ for AP in FUserInfo.AssignedProjects do
1042+ begin
1043+ Memo1.Lines.Add(AP.Name + ' | ' + AP.Description);
1044+ end;
1045+end;
1046+
1047+procedure TForm9.Button2Click(Sender: TObject);
1048+var
1049+ AP: TAssignedProject;
1050+begin
1051+ UserInfo(Self.Handle,FUserInfo);
1052+
1053+ Memo1.Clear;
1054+ for AP in FUserInfo.AssignedProjects do
1055+ begin
1056+ Memo1.Lines.Add(AP.Name + ' | ' + AP.Description);
1057+ end;
1058+end;
1059+
1060+procedure TForm9.Button3Click(Sender: TObject);
1061+var
1062+ AT: TAssignedTasks;
1063+ T: TTask;
1064+begin
1065+ Memo1.Clear;
1066+
1067+ if AssignedTasks(Self.Handle, FStatusColors, AT) then
1068+ begin
1069+ for T in AT do
1070+ begin
1071+ Memo1.Lines.Add(T.Id + ' - ' + T.Status + ' - ' + ColorToString(T.StatusColor) + ' - ' + T.Project + ' - ' +T.Description + ' - ' + T.Category + ' - ' + DateTimeToStr(T.LastUpdate));
1072+ end;
1073+
1074+// Memo1.Lines.Add('UserName = ' + UserName);
1075+// Memo1.Lines.Add('RealName = ' + RealName);
1076+ end
1077+ else
1078+ Memo1.Lines.Add('Nenhum usuário logado');
1079+end;
1080+
1081+procedure TForm9.Button4Click(Sender: TObject);
1082+begin
1083+ StatusColors(Self.Handle,FStatusColors);
1084+ ColorListBox1.Style := [cbCustomColors];
1085+end;
1086+
1087+procedure TForm9.Button5Click(Sender: TObject);
1088+var
1089+ T: TTask;
1090+ i: Word;
1091+ f: Array of String;
1092+ E: String;
1093+begin
1094+ T.Id := '0083766';
1095+ TaskDetails(Self.Handle,T);
1096+
1097+ if OpenDialog1.Execute then
1098+ begin
1099+ SetLength(f,OpenDialog1.Files.Count);
1100+
1101+ for i := 0 to Pred(OpenDialog1.Files.Count) do
1102+ f[i] := OpenDialog1.Files[i];
1103+
1104+ end;
1105+
1106+ if not AddComment(Self.Handle,T.AddCommentToken,T.MaxFileSize,83766,Memo2.Text,f,E) then
1107+ Memo1.Text := E;
1108+end;
1109+
1110+procedure TForm9.ColorListBox1GetColors(Sender: TCustomColorListBox; Items: TStrings);
1111+var
1112+ SC: TStatusColor;
1113+begin
1114+ for SC in FStatusColors do
1115+ begin
1116+ Items.AddObject('Status Code = ' + SC.Id.ToString,TObject(SC.Color));
1117+ end;
1118+end;
1119+
1120+procedure TForm9.FormShow(Sender: TObject);
1121+var
1122+ Subject: String;
1123+ Pattern: String;
1124+ Result: String;
1125+ i,j: Word;
1126+
1127+ Spaces: Word;
1128+ CharIndex: Word;
1129+begin
1130+ Subject := 'este é o e-mail: <a href="mailto:carlos@xxxx.com">xxxxxxx</a>, e este é o url <a href="http://www.xxx.com">yyyyy</a> . Isto é uma palavra em <b>negrito</b> <br /> <br/> <br/> <i>itálico</i> <u>sublinhado</u>'#13#10' Tem 10' + ' espaços antes desta linha'#13#10#9#9'Tem dois Tabs antes antes desta linha'#13#10'xxxxxxx'#13#10'<pre>Dentro do pre'#13#10'Dentro do pre</pre>'#13#10'xxxxx<pre>dentro do segundo pre</pre>';
1131+
1132+ // ---------------------------------------------------------------------------
1133+ (*
1134+ function string_strip_hrefs( $p_string ) {
1135+ # First grab mailto: hrefs. We don't care whether the URL is actually
1136+ # correct - just that it's inside an href attribute.
1137+ $p_string = preg_replace( '/<a\s[^\>]*href="mailto:([^\"]+)"[^\>]*>[^\<]*<\/a>/si',
1138+ '\1',
1139+ $p_string);
1140+
1141+ # Then grab any other href
1142+ $p_string = preg_replace( '/<a\s[^\>]*href="([^\"]+)"[^\>]*>[^\<]*<\/a>/si',
1143+ '\1',
1144+ $p_string);
1145+ return $p_string;
1146+ }
1147+
1148+ *)
1149+ Pattern := '<a\s[^\>]*href="mailto\:([^\"]+)"[^\>]*>[^\<]*<\/a>';
1150+ RegExReplaceAll(Subject,Pattern,'\1',Result);
1151+
1152+ Subject := Result;
1153+
1154+ Pattern := '<a\s[^\>]*href="([^\"]+)"[^\>]*>[^\<]*<\/a>';
1155+ RegExReplaceAll(Subject,Pattern,'\1',Result);
1156+
1157+ Subject := Result;
1158+ // ---------------------------------------------------------------------------
1159+
1160+ // ---------------------------------------------------------------------------
1161+ (*
1162+ function string_html_specialchars( $p_string ) {
1163+ # achumakov: @ added to avoid warning output in unsupported codepages
1164+ # e.g. 8859-2, windows-1257, Korean, which are treated as 8859-1.
1165+ # This is VERY important for Eastern European, Baltic and Korean languages
1166+ return preg_replace("/&amp;(#[0-9]+|[a-z]+);/i", "&$1;", @htmlspecialchars( $p_string, ENT_COMPAT, lang_get( 'charset' ) ) );
1167+ }
1168+
1169+ *)
1170+
1171+ Result := StringReplace(Subject,'&','&amp;',[rfReplaceAll]);
1172+ Result := StringReplace(Result,'"','&quot;',[rfReplaceAll]);
1173+ Result := StringReplace(Result,#39,'&apos;',[rfReplaceAll]);
1174+ Result := StringReplace(Result,'<','&lt;',[rfReplaceAll]);
1175+ Result := StringReplace(Result,'>','&gt;',[rfReplaceAll]);
1176+
1177+ Subject := Result;
1178+ // Acho que não é necessária a expressão regular aqui. Pelo que entendi ela
1179+ // serve apenas para suprir necessidades de idiomas exóticos. O objetivo da
1180+ // função é apenas substituir os caracteres especiais do texto de forma que
1181+ // ele seja exibível no browser
1182+ // ---------------------------------------------------------------------------
1183+
1184+ // ---------------------------------------------------------------------------
1185+ (*
1186+ # These are the valid html tags for multi-line fields (e.g. description)
1187+ # do NOT include href or img tags here
1188+ # do NOT include tags that have parameters (eg. <font face="arial">)
1189+ $g_html_valid_tags = 'p, li, ul, ol, br, pre, i, b, u, em';
1190+
1191+ # These are the valid html tags for single line fields (e.g. issue summary).
1192+ # do NOT include href or img tags here
1193+ # do NOT include tags that have parameters (eg. <font face="arial">)
1194+ $g_html_valid_tags_single_line = 'i, b, u, em';
1195+
1196+
1197+ function string_restore_valid_html_tags( $p_string, $p_multiline = true ) {
1198+ $t_html_valid_tags = config_get( $p_multiline ? 'html_valid_tags' : 'html_valid_tags_single_line' );
1199+
1200+ if ( OFF === $t_html_valid_tags || is_blank( $t_html_valid_tags ) ) {
1201+ return $p_string;
1202+ }
1203+
1204+ $tags = explode( ',', $t_html_valid_tags );
1205+ foreach ($tags as $key => $value) {
1206+ if ( !is_blank( $value ) ) {
1207+ $tags[$key] = trim($value);
1208+ }
1209+ }
1210+ $tags = implode( '|', $tags);
1211+
1212+ $p_string = eregi_replace( '&lt;(' . $tags . ')[[:space:]]*&gt;', '<\\1>', $p_string );
1213+ $p_string = eregi_replace( '&lt;\/(' .$tags . ')[[:space:]]*&gt;', '</\\1>', $p_string );
1214+ $p_string = eregi_replace( '&lt;(' . $tags . ')[[:space:]]*\/&gt;', '<\\1 />', $p_string );
1215+
1216+ return $p_string;
1217+ }
1218+
1219+ *)
1220+
1221+ with TStringList.Create do
1222+ try
1223+ StrictDelimiter := True;
1224+ Delimiter := ',';
1225+
1226+ if True then // parametro p_multiline
1227+ DelimitedText := StringReplace('p, li, ul, ol, br, pre, i, b, u, em',' ','',[rfReplaceAll])
1228+ else
1229+ DelimitedText := StringReplace('i, b, u, em',' ','',[rfReplaceAll]);
1230+
1231+ Delimiter := '|';
1232+
1233+ Pattern := '&lt;(' + DelimitedText + ')\s*&gt;'; // <tagname>
1234+ RegExReplaceAll(Subject,Pattern,'<\1>',Result);
1235+
1236+ Subject := Result;
1237+ Pattern := '&lt;\/(' + DelimitedText + ')\s*&gt;'; // </tagname>
1238+ RegExReplaceAll(Subject,Pattern,'</\1>',Result);
1239+
1240+ Subject := Result;
1241+ Pattern := '&lt;(' + DelimitedText + ')\s*\/&gt;'; // <tagname />
1242+ RegExReplaceAll(Subject,Pattern,'<\1 />',Result);
1243+ finally
1244+ Free;
1245+ end;
1246+
1247+ Subject := Result;
1248+ // ---------------------------------------------------------------------------
1249+
1250+ // ---------------------------------------------------------------------------
1251+ (*
1252+ ### --------------------
1253+ # Preserve spaces at beginning of lines.
1254+ # Lines must be separated by \n rather than <br />
1255+ function string_preserve_spaces_at_bol( $p_string ) {
1256+ $lines = explode( "\n", $p_string );
1257+ $line_count = count( $lines );
1258+ for ( $i = 0; $i < $line_count; $i++ ) {
1259+ $count = 0;
1260+ $prefix = '';
1261+
1262+ $t_char = substr( $lines[$i], $count, 1 );
1263+ $spaces = 0;
1264+ while ( ( $t_char == ' ' ) || ( $t_char == "\t" ) ) {
1265+ if ( $t_char == ' ' )
1266+ $spaces++;
1267+ else
1268+ $spaces += 4; // 1 tab = 4 spaces, can be configurable.
1269+
1270+ $count++;
1271+ $t_char = substr( $lines[$i], $count, 1 );
1272+ }
1273+
1274+ for ( $j = 0; $j < $spaces; $j++ ) {
1275+ $prefix .= '&nbsp;';
1276+ }
1277+
1278+ $lines[$i] = $prefix . substr( $lines[$i], $count );
1279+ }
1280+ return implode( "\n", $lines );
1281+ }
1282+ *)
1283+
1284+ with TStringList.Create do
1285+ try
1286+ Text := Subject;
1287+ if Count > 0 then
1288+ for i := 0 to Pred(Count) do
1289+ begin
1290+ Spaces := 0;
1291+ CharIndex := 1;
1292+
1293+ while Copy(Strings[i],CharIndex,1)[1] in [#32,#9] do
1294+ begin
1295+ if Copy(Strings[i],CharIndex,1)[1] = #32 then
1296+ Inc(Spaces)
1297+ else
1298+ Inc(Spaces,4); // assume cada tab encontrado como sendo = 4 espaços
1299+
1300+ Inc(CharIndex);
1301+ end;
1302+
1303+ Strings[i] := TrimLeft(Strings[i]);
1304+
1305+ if Spaces > 0 then
1306+ for j := 0 to Pred(Spaces) do
1307+ Strings[i] := '&nbsp;' + Strings[i];
1308+ end;
1309+
1310+ Subject := Text;
1311+ finally
1312+ Free;
1313+ end;
1314+ // ---------------------------------------------------------------------------
1315+ (*
1316+ # --------------------
1317+ # Similar to nl2br, but fixes up a problem where new lines are doubled between
1318+ # <pre> tags.
1319+ # additionally, wrap the text an $p_wrap character intervals if the config is set
1320+ function string_nl2br( $p_string, $p_wrap = 100 ) {
1321+ $output = '';
1322+ $pieces = preg_split('/(<pre[^>]*>.*?<\/pre>)/is', $p_string, -1, PREG_SPLIT_DELIM_CAPTURE);
1323+ if(isset($pieces[1]))
1324+ {
1325+ foreach($pieces as $piece)
1326+ {
1327+ if(preg_match('/(<pre[^>]*>.*?<\/pre>)/is', $piece))
1328+ {
1329+ $piece = preg_replace("/<br[^>]*?>/", "", $piece);
1330+ # @@@ thraxisp - this may want to be replaced by html_entity_decode (or equivalent)
1331+ # if other encoded characters are a problem
1332+ $piece = preg_replace("/&nbsp;/", " ", $piece);
1333+ if ( ON == config_get( 'wrap_in_preformatted_text' ) ) {
1334+ $output .= preg_replace('/([^\n]{'.$p_wrap.'})(?!<\/pre>)/', "$1\n", $piece);
1335+ } else {
1336+ $output .= $piece;
1337+ }
1338+ } else {
1339+ $output .= nl2br($piece);
1340+ }
1341+ }
1342+ return $output;
1343+ } else {
1344+ return nl2br($p_string);
1345+ }
1346+ }
1347+ *)
1348+ // Não fiz a parte do meio que parece substituir <br> e &nbsp; que estão
1349+ // dentro do <pre>
1350+ Subject := RegExProtectAndReplace(Subject,'(<pre[^>]*>.*?<\/pre>)',#13#10,'<br>'#13#10);
1351+ // ---------------------------------------------------------------------------
1352+ // # --------------------
1353+ // # Detect URLs and email addresses in the string and replace them with href anchors
1354+ // function string_insert_hrefs( $p_string ) {
1355+ // if ( !config_get( 'html_make_links' ) ) {
1356+ // return $p_string;
1357+ // }
1358+ //
1359+ // $t_change_quotes = false;
1360+ // if( ini_get_bool( 'magic_quotes_sybase' ) ) {
1361+ // $t_change_quotes = true;
1362+ // ini_set( 'magic_quotes_sybase', false );
1363+ // }
1364+ //
1365+ // # Find any URL in a string and replace it by a clickable link
1366+ // $p_string = preg_replace( '/(([[:alpha:]][-+.[:alnum:]]*):\/\/(%[[:digit:]A-Fa-f]{2}|[-_.!~*\';\/?%^\\\\:@&={\|}+$#\(\),\[\][:alnum:]])+)/se',
1367+ // "'<a href=\"'.rtrim('\\1','.').'\">\\1</a> [<a href=\"'.rtrim('\\1','.').'\" target=\"_blank\">^</a>]'",
1368+ // $p_string);
1369+ // if( $t_change_quotes ) {
1370+ // ini_set( 'magic_quotes_sybase', true );
1371+ // }
1372+ //
1373+ // $p_string = preg_replace( '/\b' . email_regex_simple() . '\b/i',
1374+ // '<a href="mailto:\0">\0</a>',
1375+ // $p_string);
1376+ //
1377+ // return $p_string;
1378+ // }
1379+
1380+ // Não useis as mesmas expressões regulares
1381+ RegExReplaceAll(Subject,'(\b(?:https?|ftps?):\/\/[a-z0-9-_.]*\b)','<a href="\1">\1</a> [<a href="\1" target="_blank">^</a>]',Result,False);
1382+ RegExReplaceAll(Subject,'(\b.*@.*\b)','<a href="mailto:\1">\1</a>',Result,False);
1383+
1384+ + Subject := Result;
1385+ + // ---------------------------------------------------------------------------
1386+end;
1387+{$WARNINGS ON}
1388+
1389+end.
旧リポジトリブラウザで表示