ModBase.vb 136 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747
  1. Imports System.Globalization
  2. Imports System.IO.Compression
  3. Imports System.Runtime.CompilerServices
  4. Imports System.Security.Cryptography
  5. Imports System.Security.Principal
  6. Imports System.Text.RegularExpressions
  7. Imports System.Windows.Markup
  8. Imports Newtonsoft.Json
  9. Public Module ModBase
  10. #Region "声明"
  11. '下列版本信息由更新器自动修改
  12. Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
  13. Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
  14. Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
  15. #If BETA Then
  16. Public Const VersionCode As Integer = 336 'Release
  17. #Else
  18. Public Const VersionCode As Integer = 337 'Snapshot
  19. #End If
  20. '自动生成的版本信息
  21. Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
  22. #If RELEASE Then
  23. Public Const VersionBranchName As String = "Snapshot"
  24. Public Const VersionBranchCode As String = "0"
  25. #ElseIf BETA Then
  26. Public Const VersionBranchName As String = "Release"
  27. Public Const VersionBranchCode As String = "50"
  28. #Else
  29. Public Const VersionBranchName As String = "Debug"
  30. Public Const VersionBranchCode As String = "100"
  31. #End If
  32. ''' <summary>
  33. ''' 主窗口句柄。
  34. ''' </summary>
  35. Public Handle As IntPtr
  36. ''' <summary>
  37. ''' 程序的启动路径,以“\”结尾。
  38. ''' </summary>
  39. Public Path As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
  40. ''' <summary>
  41. ''' 包含程序名的完整路径。
  42. ''' </summary>
  43. Public PathWithName As String = Path & AppDomain.CurrentDomain.SetupInformation.ApplicationName
  44. ''' <summary>
  45. ''' 程序内嵌图片文件夹路径,以“/”结尾。
  46. ''' </summary>
  47. Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
  48. ''' <summary>
  49. ''' 当前程序的语言。
  50. ''' </summary>
  51. Public Lang As String = "zh_CN"
  52. ''' <summary>
  53. ''' 设置对象。
  54. ''' </summary>
  55. Public Setup As New ModSetup
  56. ''' <summary>
  57. ''' 程序的打开计时。
  58. ''' </summary>
  59. Public ApplicationStartTick As Long = GetTimeTick()
  60. ''' <summary>
  61. ''' 程序打开时的时间。
  62. ''' </summary>
  63. Public ApplicationOpenTime As Date = Date.Now
  64. ''' <summary>
  65. ''' 识别码。
  66. ''' </summary>
  67. Public UniqueAddress As String = SecretGetUniqueAddress()
  68. ''' <summary>
  69. ''' 程序是否已结束。
  70. ''' </summary>
  71. Public IsProgramEnded As Boolean = False
  72. ''' <summary>
  73. ''' 是否为 32 位系统。
  74. ''' </summary>
  75. Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
  76. ''' <summary>
  77. ''' 是否使用 GBK 编码。
  78. ''' </summary>
  79. Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
  80. ''' <summary>
  81. ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
  82. ''' </summary>
  83. Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
  84. ''' <summary>
  85. ''' 程序的缓存文件夹路径,以 \ 结尾。
  86. ''' </summary>
  87. Public PathTemp As String = If(Setup.Get("SystemSystemCache") = "", IO.Path.GetTempPath() & "PCL\", Setup.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
  88. ''' <summary>
  89. ''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
  90. ''' </summary>
  91. Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
  92. #End Region
  93. #Region "矢量图标"
  94. Public Class Logo
  95. ''' <summary>
  96. ''' 图标按钮,心(空心),1.1x
  97. ''' </summary>
  98. Public Const IconButtonLikeLine As String = "M512 896a42.666667 42.666667 0 0 1-30.293333-12.373333l-331.52-331.946667a224.426667 224.426667 0 0 1 0-315.733333 223.573333 223.573333 0 0 1 315.733333 0L512 282.026667l46.08-46.08a223.573333 223.573333 0 0 1 315.733333 0 224.426667 224.426667 0 0 1 0 315.733333l-331.52 331.946667A42.666667 42.666667 0 0 1 512 896zM308.053333 256a136.533333 136.533333 0 0 0-97.28 40.106667 138.24 138.24 0 0 0 0 194.986666L512 792.746667l301.226667-301.653334a138.24 138.24 0 0 0 0-194.986666 141.653333 141.653333 0 0 0-194.56 0l-76.373334 76.8a42.666667 42.666667 0 0 1-60.586666 0L405.333333 296.106667A136.533333 136.533333 0 0 0 308.053333 256z"
  99. ''' <summary>
  100. ''' 图标按钮,心(实心),1.1x
  101. ''' </summary>
  102. Public Const IconButtonLikeFill As String = "M700.856 155.543c-74.769 0-144.295 72.696-190.046 127.26-45.737-54.576-115.247-127.26-190.056-127.26-134.79 0-244.443 105.78-244.443 235.799 0 77.57 39.278 131.988 70.845 175.713C238.908 694.053 469.62 852.094 479.39 858.757c9.41 6.414 20.424 9.629 31.401 9.629 11.006 0 21.998-3.215 31.398-9.63 9.782-6.662 240.514-164.703 332.238-291.701 31.587-43.724 70.874-98.143 70.874-175.713-0.001-130.02-109.656-235.8-244.445-235.8z m0 0"
  103. ''' <summary>
  104. ''' 图标按钮,垃圾桶,1.1x
  105. ''' </summary>
  106. Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
  107. ''' <summary>
  108. ''' 图标按钮,禁止,1x
  109. ''' </summary>
  110. Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
  111. ''' <summary>
  112. ''' 图标按钮,勾选,1x
  113. ''' </summary>
  114. Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
  115. ''' <summary>
  116. ''' 图标按钮,笔,1x
  117. ''' </summary>
  118. Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
  119. ''' <summary>
  120. ''' 图标按钮,齿轮,1.1x
  121. ''' </summary>
  122. Public Const IconButtonSetup As String = "M651.946667 1001.813333c-22.186667 0-42.666667-10.24-61.44-27.306666-23.893333-23.893333-49.493333-35.84-75.093334-35.84-29.013333 0-56.32 11.946667-73.386666 30.72v3.413333c-17.066667 17.066667-42.666667 27.306667-66.56 27.306667h-6.826667c-6.826667 0-11.946667-1.706667-15.36-1.706667l-6.826667-1.706667c-64.853333-20.48-121.173333-54.613333-168.96-98.986666-29.013333-23.893333-37.546667-63.146667-25.6-95.573334 8.533333-23.893333 5.12-51.2-10.24-75.093333-15.36-27.306667-34.133333-40.96-59.733333-47.786667h-1.706667l-5.12-1.706666c-35.84-8.533333-61.44-34.133333-66.56-69.973334C1.706667 575.146667 0 537.6 0 512c0-32.426667 3.413333-63.146667 8.533333-93.866667v-6.826666l3.413334-8.533334c10.24-23.893333 23.893333-40.96 44.373333-51.2 5.12-3.413333 11.946667-6.826667 20.48-8.533333 27.306667-8.533333 51.2-25.6 63.146667-44.373333 13.653333-23.893333 17.066667-52.906667 10.24-81.92-11.946667-34.133333 0-71.68 30.72-93.866667 44.373333-37.546667 97.28-68.266667 158.72-93.866667l3.413333-1.706666c44.373333-13.653333 75.093333 3.413333 92.16 20.48 23.893333 23.893333 49.493333 35.84 75.093333 35.84 30.72 0 56.32-10.24 71.68-30.72l3.413334-3.413334c27.306667-27.306667 63.146667-35.84 93.866666-22.186666 63.146667 22.186667 117.76 54.613333 165.546667 97.28 29.013333 23.893333 37.546667 63.146667 25.6 95.573333-8.533333 23.893333-5.12 51.2 10.24 75.093333 15.36 27.306667 34.133333 40.96 59.733333 47.786667h1.706667l5.12 1.706667c35.84 8.533333 61.44 34.133333 66.56 71.68 6.826667 30.72 10.24 63.146667 11.946667 93.866666v3.413334c0 32.426667-3.413333 63.146667-8.533334 93.866666v6.826667l-3.413333 8.533333c-10.24 23.893333-23.893333 40.96-44.373333 51.2-5.12 3.413333-11.946667 6.826667-20.48 8.533334-27.306667 8.533333-51.2 25.6-63.146667 46.08-13.653333 23.893333-17.066667 52.906667-10.24 81.92 11.946667 35.84-1.706667 75.093333-30.72 95.573333-44.373333 35.84-95.573333 66.56-157.013333 92.16-15.36 3.413333-27.306667 3.413333-35.84 3.413333z m3.413333-83.626666z m1.706667 0zM517.12 853.333333c47.786667 0 93.866667 20.48 134.826667 59.733334 1.706667 1.706667 3.413333 1.706667 3.413333 3.413333 52.906667-22.186667 97.28-49.493333 136.533333-80.213333l1.706667-1.706667v-3.413333c-13.653333-52.906667-8.533333-104.106667 17.066667-148.48 23.893333-39.253333 64.853333-69.973333 114.346666-85.333334 1.706667 0 3.413333-1.706667 6.826667-6.826666 5.12-25.6 8.533333-51.2 8.533333-78.506667-1.706667-29.013333-3.413333-56.32-10.24-81.92v-5.12h-1.706666c-51.2-11.946667-90.453333-39.253333-119.466667-87.04-27.306667-44.373333-34.133333-100.693333-17.066667-148.48l-1.706666-1.706667h-3.413334c-39.253333-35.84-85.333333-63.146667-136.533333-80.213333H648.533333s-1.706667 1.706667-3.413333 1.706667c-32.426667 39.253333-80.213333 59.733333-136.533333 59.733333-47.786667 0-93.866667-20.48-134.826667-59.733333l-1.706667-1.706667h-1.706666c-54.613333 22.186667-98.986667 49.493333-136.533334 80.213333l-1.706666 1.706667v3.413333c13.653333 52.906667 8.533333 104.106667-17.066667 148.48-23.893333 39.253333-64.853333 69.973333-114.346667 85.333334-1.706667 0-3.413333 1.706667-6.826666 6.826666-6.826667 25.6-8.533333 51.2-8.533334 78.506667 0 30.72 3.413333 58.026667 6.826667 76.8l1.706667 5.12h1.706666c51.2 11.946667 90.453333 39.253333 119.466667 87.04 27.306667 44.373333 34.133333 100.693333 17.066667 148.48l1.706666 1.706667 1.706667 1.706666c37.546667 35.84 83.626667 63.146667 134.826667 80.213334 1.706667 0 3.413333 0 3.413333 1.706666h1.706667s1.706667 0 5.12-1.706666c34.133333-37.546667 81.92-59.733333 136.533333-59.733334z m-6.826667-146.773333c-110.933333 0-199.68-85.333333-199.68-196.266667 0-109.226667 87.04-196.266667 199.68-196.266666s199.68 85.333333 199.68 196.266666c-1.706667 109.226667-88.746667 196.266667-199.68 196.266667z m0-307.2c-63.146667 0-114.346667 49.493333-114.346666 110.933333 0 63.146667 49.493333 110.933333 114.346666 110.933334 30.72 0 59.733333-11.946667 80.213334-32.426667 20.48-20.48 32.426667-49.493333 32.426666-78.506667 0-63.146667-49.493333-110.933333-112.64-110.933333z"
  123. ''' <summary>
  124. ''' 图标按钮,重置,0.9x
  125. ''' </summary>
  126. Public Const IconButtonReset As String = "M667.6817627 313.65283203l-45.28564454 55.76660156L858.06933594 391.27124023 787.61950684 165.93066406l-56.01379395 69.01611328A354.47387695 354.47387695 0 0 0 520.89892578 165.93066406C324.87536621 165.93066406 165.93066406 324.43041992 165.93066406 519.91015625c0 195.52917481 158.94470215 353.97949219 354.96826172 353.97949219a355.06713867 355.06713867 0 0 0 331.73217774-227.66418458 50.52612305 50.52612305 0 0 0-29.21813966-65.25878905 50.77331543 50.77331543 0 0 0-65.50598144 29.16870117A253.61938477 253.61938477 0 0 1 520.94836426 772.78796387c-140.05920411 0-253.61938477-113.21411133-253.61938477-252.87780762 0-139.61425781 113.56018067-252.82836914 253.61938477-252.82836914 53.59130859 0 104.46350098 16.61132813 146.73339843 46.57104492"
  127. ''' <summary>
  128. ''' 图标按钮,刷新,0.85x
  129. ''' </summary>
  130. Public Const IconButtonRefresh As String = "M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"
  131. ''' <summary>
  132. ''' 图标按钮,软盘,1x
  133. ''' </summary>
  134. Public Const IconButtonSave As String = "M819.392 0L1024 202.752v652.16a168.96 168.96 0 0 1-168.832 168.768h-104.192a47.296 47.296 0 0 1-10.752 0H283.776a47.232 47.232 0 0 1-10.752 0H168.832A168.96 168.96 0 0 1 0 854.912V168.768A168.96 168.96 0 0 1 168.832 0h650.56z m110.208 854.912V242.112l-149.12-147.776H168.896c-41.088 0-74.432 33.408-74.432 74.432v686.144c0 41.024 33.344 74.432 74.432 74.432h62.4v-190.528c0-33.408 27.136-60.544 60.544-60.544h440.448c33.408 0 60.544 27.136 60.544 60.544v190.528h62.4c41.088 0 74.432-33.408 74.432-74.432z m-604.032 74.432h372.864v-156.736H325.568v156.736z m403.52-596.48a47.168 47.168 0 1 1 0 94.336H287.872a47.168 47.168 0 1 1 0-94.336h441.216z m0-153.728a47.168 47.168 0 1 1 0 94.4H287.872a47.168 47.168 0 1 1 0-94.4h441.216z"
  135. ''' <summary>
  136. ''' 图标按钮,信息,1.05x
  137. ''' </summary>
  138. Public Const IconButtonInfo As String = "M512 917.333333c223.861333 0 405.333333-181.472 405.333333-405.333333S735.861333 106.666667 512 106.666667 106.666667 288.138667 106.666667 512s181.472 405.333333 405.333333 405.333333z m0 106.666667C229.226667 1024 0 794.773333 0 512S229.226667 0 512 0s512 229.226667 512 512-229.226667 512-512 512z m-32-597.333333h64a21.333333 21.333333 0 0 1 21.333333 21.333333v320a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333V448a21.333333 21.333333 0 0 1 21.333333-21.333333z m0-192h64a21.333333 21.333333 0 0 1 21.333333 21.333333v64a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333v-64a21.333333 21.333333 0 0 1 21.333333-21.333333z"
  139. ''' <summary>
  140. ''' 图标按钮,列表,1x
  141. ''' </summary>
  142. Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z"
  143. ''' <summary>
  144. ''' 图标按钮,文件夹,1.15x
  145. ''' </summary>
  146. Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z"
  147. ''' <summary>
  148. ''' 图标按钮,名片,1.1x
  149. ''' </summary>
  150. Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z"
  151. ''' <summary>
  152. ''' 图标按钮,×,0.85x
  153. ''' </summary>
  154. Public Const IconButtonCross As String = "F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
  155. ''' <summary>
  156. ''' 图标按钮,Mojang,1.1x
  157. ''' </summary>
  158. Public Const IconButtonMojang As String = "M9.183,18.967c-0.109-2.239,1.336-5.119,3.92-4.96c3.657-0.027,7.319-0.044,10.977,0.005 c3.712,0.214,6.596,2.759,9.652,4.533c0.181-1.697-0.197-3.717,1.237-4.982c1.899,2.091,3.143,4.894,5.677,6.334 c1.577,0.805,2.973-0.668,4.221-1.44c1.55,2.305,2.108,5.075,2.622,7.752c0.657,3.438,0.947,6.925,1.111,10.413 c-1.734-0.733-3.355-1.708-4.971-2.671c-1.396-4.933-5.349-8.656-9.723-11.059c-3.46-1.817-7.752-2.185-11.338-0.52 c-3.761,1.593-6.285,5.666-5.891,9.75c0.121,4.577,3.17,8.765,7.391,10.456c7.746,3.285,16.407,2.234,24.521,1.243 c0.454,2.315-1.511,4.527-3.695,4.889c-10.577,0.038-21.148-0.011-31.725,0.022c-2.217,0.279-4.079-1.879-3.964-4.008 C9.167,36.141,9.216,27.556,9.183,18.967z M40.114,8.09c0.294-0.801,0.872-1.417,1.542-1.924c1.379,2.589,2.742,5.482,2.311,8.491 c-0.332,2.54-4.42,2.507-5.052,0.163C38.349,12.527,39.209,10.178,40.114,8.09z M0,53 l0.1,0 z"
  159. ''' <summary>
  160. ''' 图标按钮,用户,0.95x
  161. ''' </summary>
  162. Public Const IconButtonUser As String = "M660.338 528.065c63.61-46.825 105.131-121.964 105.131-206.83 0-141.7-115.29-256.987-256.997-256.987-141.706 0-256.998 115.288-256.998 256.987 0 85.901 42.52 161.887 107.456 208.562-152.1 59.92-260.185 207.961-260.185 381.077 0 21.276 17.253 38.53 38.53 38.53 21.278 0 38.53-17.254 38.53-38.53 0-183.426 149.232-332.671 332.667-332.671 1.589 0 3.113-0.207 4.694-0.244 0.8 0.056 1.553 0.244 2.362 0.244 183.434 0 332.664 149.245 332.664 332.671 0 21.276 17.255 38.53 38.533 38.53 21.277 0 38.53-17.254 38.53-38.53 0-174.885-110.354-324.13-264.917-382.809z m-331.803-206.83c0-99.22 80.72-179.927 179.935-179.927s179.937 80.708 179.937 179.927c0 99.203-80.721 179.91-179.937 179.91s-179.935-80.708-179.935-179.91z"
  163. ''' <summary>
  164. ''' 图标按钮,盾牌,1x
  165. ''' </summary>
  166. Public Const IconButtonShield As String = "M511.488256 95.184408c35.310345 22.516742 95.184408 55.78011 167.34033 84.437781 75.738131 29.681159 148.405797 40.93953 191.392304 45.033483v353.615193c0 73.691154-50.662669 164.781609-136.123938 244.101949C649.65917 901.181409 558.568716 942.12094 512 942.12094c-46.568716 0-137.65917-40.93953-222.096952-119.748126C204.441779 742.54073 153.77911 651.450275 153.77911 577.247376v-353.103448c42.474763-4.093953 116.165917-15.352324 191.904048-45.545227 75.226387-30.192904 133.565217-63.456272 165.805098-83.414293M512 0c-4.093953 0-8.187906 1.535232-11.258371 3.582209l-14.84058 10.234882c-1.023488 0.511744-67.550225 47.592204-170.410794 88.531735-100.813593 39.916042-198.556722 41.963018-199.58021 41.963018l-25.075462 0.511744c-10.746627 0.511744-18.934533 8.187906-18.934533 18.422789v414.000999c0 216.97951 286.064968 446.24088 440.09995 446.24088s440.09995-229.261369 440.09995-445.729136V163.758121c0-10.234883-8.69965-18.422789-18.934533-18.422789l-24.563718-0.511744c-1.023488 0-98.766617-2.046977-199.58021-41.963018-103.372314-40.93953-170.410795-88.01999-170.922538-88.531734L523.258371 3.582209c-3.070465-2.558721-7.164418-3.582209-11.258371-3.582209z M743.308346 410.930535l-260.477761 260.477761c-15.864068 15.864068-41.963018 15.864068-57.827087 0l-144.823588-144.823588c-15.864068-15.864068-15.864068-41.963018 0-57.827087 8.187906-8.187906 18.422789-11.770115 29.169415-11.770115 10.234883 0 20.981509 4.093953 29.169416 11.770115l115.654173 115.654173L685.993003 352.591704c15.864068-15.864068 41.963018-15.864068 57.827087 0 15.352324 16.375812 15.352324 42.474763-0.511744 58.338831z"
  167. ''' <summary>
  168. ''' 图标按钮,离线,0.85x
  169. ''' </summary>
  170. Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
  171. ''' <summary>
  172. ''' 图标,音符,1x
  173. ''' </summary>
  174. Public Const IconButtonServer As String = "M640 725.333333a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-256 0H256a42.666667 42.666667 0 0 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z m384 0a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-128-256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-256 0H256a42.666667 42.666667 0 1 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z m384-256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m0 256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m170.666667-256a128 128 0 0 0-128-128H213.333333a128 128 0 0 0-128 128v85.333334a128 128 0 0 0 33.28 85.333333A128 128 0 0 0 85.333333 469.333333v85.333334a128 128 0 0 0 33.28 85.333333A128 128 0 0 0 85.333333 725.333333v85.333334a128 128 0 0 0 128 128h597.333334a128 128 0 0 0 128-128v-85.333334a128 128 0 0 0-33.28-85.333333 128 128 0 0 0 33.28-85.333333v-85.333334a128 128 0 0 0-33.28-85.333333A128 128 0 0 0 938.666667 298.666667V213.333333z m-85.333334 597.333334a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666v-85.333334a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m0-256a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666v-85.333334a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m0-256a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666V213.333333a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m-213.333333-85.333334a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334zM384 213.333333H256a42.666667 42.666667 0 1 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z"
  175. ''' <summary>
  176. ''' 图标,音符,1x
  177. ''' </summary>
  178. Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z"
  179. ''' <summary>
  180. ''' 图标,播放,0.8x
  181. ''' </summary>
  182. Public Const IconPlay As String = "M803.904 463.936a55.168 55.168 0 0 1 0 96.128l-463.616 264.448C302.848 845.888 256 819.136 256 776.448V247.616c0-42.752 46.848-69.44 84.288-48.064l463.616 264.384z"
  183. End Class
  184. #End Region
  185. #Region "自定义类"
  186. ''' <summary>
  187. ''' 支持小数与常见类型隐式转换的颜色。
  188. ''' </summary>
  189. Public Class MyColor
  190. Public A As Double = 255
  191. Public R As Double = 0
  192. Public G As Double = 0
  193. Public B As Double = 0
  194. '类型转换
  195. Public Shared Widening Operator CType(str As String) As MyColor
  196. Return New MyColor(str)
  197. End Operator
  198. Public Shared Widening Operator CType(col As Color) As MyColor
  199. Return New MyColor(col)
  200. End Operator
  201. Public Shared Widening Operator CType(conv As MyColor) As Color
  202. Return Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))
  203. End Operator
  204. Public Shared Widening Operator CType(conv As MyColor) As System.Drawing.Color
  205. Return System.Drawing.Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))
  206. End Operator
  207. Public Shared Widening Operator CType(bru As SolidColorBrush) As MyColor
  208. Return New MyColor(bru.Color)
  209. End Operator
  210. Public Shared Widening Operator CType(conv As MyColor) As SolidColorBrush
  211. Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)))
  212. End Operator
  213. Public Shared Widening Operator CType(bru As Brush) As MyColor
  214. Return New MyColor(bru)
  215. End Operator
  216. Public Shared Widening Operator CType(conv As MyColor) As Brush
  217. Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)))
  218. End Operator
  219. '颜色运算
  220. Public Shared Operator +(a As MyColor, b As MyColor) As MyColor
  221. Return New MyColor With {.A = a.A + b.A, .B = a.B + b.B, .G = a.G + b.G, .R = a.R + b.R}
  222. End Operator
  223. Public Shared Operator -(a As MyColor, b As MyColor) As MyColor
  224. Return New MyColor With {.A = a.A - b.A, .B = a.B - b.B, .G = a.G - b.G, .R = a.R - b.R}
  225. End Operator
  226. Public Shared Operator *(a As MyColor, b As Double) As MyColor
  227. Return New MyColor With {.A = a.A * b, .B = a.B * b, .G = a.G * b, .R = a.R * b}
  228. End Operator
  229. Public Shared Operator /(a As MyColor, b As Double) As MyColor
  230. Return New MyColor With {.A = a.A / b, .B = a.B / b, .G = a.G / b, .R = a.R / b}
  231. End Operator
  232. Public Shared Operator =(a As MyColor, b As MyColor) As Boolean
  233. If IsNothing(a) AndAlso IsNothing(b) Then Return True
  234. If IsNothing(a) OrElse IsNothing(b) Then Return False
  235. Return a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B
  236. End Operator
  237. Public Shared Operator <>(a As MyColor, b As MyColor) As Boolean
  238. If IsNothing(a) AndAlso IsNothing(b) Then Return False
  239. If IsNothing(a) OrElse IsNothing(b) Then Return True
  240. Return Not (a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B)
  241. End Operator
  242. '构造函数
  243. Public Sub New()
  244. End Sub
  245. Public Sub New(col As Color)
  246. Me.A = col.A
  247. Me.R = col.R
  248. Me.G = col.G
  249. Me.B = col.B
  250. End Sub
  251. Public Sub New(HexString As String)
  252. Dim StringColor As Media.Color = ColorConverter.ConvertFromString(HexString)
  253. A = StringColor.A
  254. R = StringColor.R
  255. G = StringColor.G
  256. B = StringColor.B
  257. End Sub
  258. Public Sub New(newA As Double, col As MyColor)
  259. Me.A = newA
  260. Me.R = col.R
  261. Me.G = col.G
  262. Me.B = col.B
  263. End Sub
  264. Public Sub New(newR As Double, newG As Double, newB As Double)
  265. Me.A = 255
  266. Me.R = newR
  267. Me.G = newG
  268. Me.B = newB
  269. End Sub
  270. Public Sub New(newA As Double, newR As Double, newG As Double, newB As Double)
  271. Me.A = newA
  272. Me.R = newR
  273. Me.G = newG
  274. Me.B = newB
  275. End Sub
  276. Public Sub New(brush As Brush)
  277. Dim Color As Color = CType(brush, SolidColorBrush).Color
  278. A = Color.A
  279. R = Color.R
  280. G = Color.G
  281. B = Color.B
  282. End Sub
  283. Public Sub New(brush As SolidColorBrush)
  284. Dim Color As Color = brush.Color
  285. A = Color.A
  286. R = Color.R
  287. G = Color.G
  288. B = Color.B
  289. End Sub
  290. Public Sub New(obj As Object)
  291. If obj Is Nothing Then
  292. A = 255 : R = 255 : G = 255 : B = 255
  293. Else
  294. If TypeOf obj Is SolidColorBrush Then
  295. '避免反复获取 Color 对象造成性能下降
  296. Dim Color As Color = CType(obj, SolidColorBrush).Color
  297. A = Color.A
  298. R = Color.R
  299. G = Color.G
  300. B = Color.B
  301. Else
  302. A = obj.A
  303. R = obj.R
  304. G = obj.G
  305. B = obj.B
  306. End If
  307. End If
  308. End Sub
  309. 'HSL
  310. Public Function Hue(v1 As Double, v2 As Double, vH As Double) As Double
  311. If vH < 0 Then vH += 1
  312. If vH > 1 Then vH -= 1
  313. If vH < 0.16667 Then Return v1 + (v2 - v1) * 6 * vH
  314. If vH < 0.5 Then Return v2
  315. If vH < 0.66667 Then Return v1 + (v2 - v1) * (4 - vH * 6)
  316. Return v1
  317. End Function
  318. Public Function FromHSL(sH As Double, sS As Double, sL As Double) As MyColor
  319. If sS = 0 Then
  320. R = sL * 2.55
  321. G = R
  322. B = R
  323. Else
  324. Dim H = sH / 360
  325. Dim S = sS / 100
  326. Dim L = sL / 100
  327. S = If(L < 0.5, S * L + L, S * (1.0 - L) + L)
  328. L = 2 * L - S
  329. R = 255 * Hue(L, S, H + 1 / 3)
  330. G = 255 * Hue(L, S, H)
  331. B = 255 * Hue(L, S, H - 1 / 3)
  332. End If
  333. A = 255
  334. Return Me
  335. End Function
  336. Public Function FromHSL2(sH As Double, sS As Double, sL As Double) As MyColor
  337. If sS = 0 Then
  338. R = sL * 2.55 : G = R : B = R
  339. Else
  340. '初始化
  341. sH = (sH + 3600000) Mod 360
  342. Dim cent As Double() = {
  343. +0.1, -0.06, -0.3, '0, 30, 60
  344. -0.19, -0.15, -0.24, '90, 120, 150
  345. -0.32, -0.09, +0.18, '180, 210, 240
  346. +0.05, -0.12, -0.02, '270, 300, 330
  347. +0.1, -0.06} '最后两位与前两位一致,加是变亮,减是变暗
  348. '计算色调对应的亮度片区
  349. Dim center As Double = sH / 30.0
  350. Dim intCenter As Integer = Math.Floor(center) '亮度片区编号
  351. center = 50 - (
  352. (1 - center + intCenter) * cent(intCenter) + (center - intCenter) * cent(intCenter + 1)
  353. ) * sS
  354. 'center = 50 + (cent(intCenter) + (center - intCenter) * (cent(intCenter + 1) - cent(intCenter))) * sS
  355. sL = If(sL < center, sL / center, 1 + (sL - center) / (100 - center)) * 50
  356. FromHSL(sH, sS, sL)
  357. End If
  358. A = 255
  359. Return Me
  360. End Function
  361. Public Overrides Function ToString() As String
  362. Return "(" & A & "," & R & "," & G & "," & B & ")"
  363. End Function
  364. Public Overrides Function Equals(obj As Object) As Boolean
  365. Return Me = obj
  366. End Function
  367. End Class
  368. ''' <summary>
  369. ''' 支持负数与浮点数的矩形。
  370. ''' </summary>
  371. Public Class MyRect
  372. '属性
  373. Public Property Width As Double = 0
  374. Public Property Height As Double = 0
  375. Public Property Left As Double = 0
  376. Public Property Top As Double = 0
  377. '构造函数
  378. Public Sub New()
  379. End Sub
  380. Public Sub New(left As Double, top As Double, width As Double, height As Double)
  381. Me.Left = left
  382. Me.Top = top
  383. Me.Width = width
  384. Me.Height = height
  385. End Sub
  386. End Class
  387. ''' <summary>
  388. ''' 模块加载状态枚举。
  389. ''' </summary>
  390. Public Enum LoadState
  391. Waiting
  392. Loading
  393. Finished
  394. Failed
  395. Aborted
  396. End Enum
  397. ''' <summary>
  398. ''' 执行返回值。
  399. ''' </summary>
  400. Public Enum Result
  401. ''' <summary>
  402. ''' 执行成功,或进程被中断。
  403. ''' </summary>
  404. Aborted = -1
  405. ''' <summary>
  406. ''' 执行成功。
  407. ''' </summary>
  408. Success = 0
  409. ''' <summary>
  410. ''' 执行失败。
  411. ''' </summary>
  412. Fail
  413. ''' <summary>
  414. ''' 执行时出现未经处理的异常。
  415. ''' </summary>
  416. Exception
  417. ''' <summary>
  418. ''' 执行超时。
  419. ''' </summary>
  420. Timeout
  421. ''' <summary>
  422. ''' 取消执行。可能是由于不满足执行的前置条件。
  423. ''' </summary>
  424. Cancel
  425. End Enum
  426. ''' <summary>
  427. ''' 可以使用 Equals 和等号的 List。
  428. ''' </summary>
  429. Public Class EqualableList(Of T)
  430. Inherits List(Of T)
  431. Public Overrides Function Equals(obj As Object) As Boolean
  432. If TryCast(obj, List(Of T)) Is Nothing Then
  433. '类型不同
  434. Return False
  435. Else
  436. '类型相同
  437. Dim objList As List(Of T) = obj
  438. If objList.Count <> Count Then Return False
  439. For i = 0 To objList.Count - 1
  440. If Not objList(i).Equals(Me(i)) Then Return False
  441. Next
  442. Return True
  443. End If
  444. End Function
  445. Public Shared Operator =(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  446. Return EqualityComparer(Of EqualableList(Of T)).Default.Equals(left, right)
  447. End Operator
  448. Public Shared Operator <>(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  449. Return Not left = right
  450. End Operator
  451. End Class
  452. #End Region
  453. #Region "数学"
  454. ''' <summary>
  455. ''' 2~65 进制的转换。
  456. ''' </summary>
  457. Public Function RadixConvert(Input As String, FromRadix As Integer, ToRadix As Integer) As String
  458. Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
  459. '零与负数的处理
  460. If String.IsNullOrEmpty(Input) Then Return "0"
  461. Dim IsNegative As Boolean = Input.StartsWithF("-")
  462. If IsNegative Then Input = Input.TrimStart("-")
  463. '转换为十进制
  464. Dim RealNum As Long = 0, Scale As Long = 1
  465. For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOfF(l))
  466. RealNum += Digit * Scale
  467. Scale *= FromRadix
  468. Next
  469. '转换为指定进制
  470. Dim Result = ""
  471. While RealNum > 0
  472. Dim NewNum As Integer = RealNum Mod ToRadix
  473. RealNum = (RealNum - NewNum) / ToRadix
  474. Result = Digits(NewNum) & Result
  475. End While
  476. '负数的结束处理与返回
  477. Return If(IsNegative, "-", "") & Result
  478. End Function
  479. ''' <summary>
  480. ''' 计算二阶贝塞尔曲线。
  481. ''' </summary>
  482. Public Function MathBezier(x As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, Optional acc As Double = 0.01) As Double
  483. If x <= 0 OrElse Double.IsNaN(x) Then Return 0
  484. If x >= 1 Then Return 1
  485. Dim a, b
  486. a = x
  487. Do
  488. b = 3 * a * ((0.33333333 + x1 - x2) * a * a + (x2 - 2 * x1) * a + x1)
  489. a += (x - b) * 0.5
  490. Loop Until Math.Abs(b - x) < acc '精度
  491. Return 3 * a * ((0.33333333 + y1 - y2) * a * a + (y2 - 2 * y1) * a + y1)
  492. End Function
  493. ''' <summary>
  494. ''' 将一个数字限制为 0~255 的 Byte 值。
  495. ''' </summary>
  496. Public Function MathByte(d As Double) As Byte
  497. If d < 0 Then d = 0
  498. If d > 255 Then d = 255
  499. Return Math.Round(d)
  500. End Function
  501. ''' <summary>
  502. ''' 提供 MyColor 类型支持的 Math.Round。
  503. ''' </summary>
  504. Public Function MathRound(col As MyColor, Optional w As Integer = 0) As MyColor
  505. Return New MyColor With {.A = Math.Round(col.A, w), .R = Math.Round(col.R, w), .G = Math.Round(col.G, w), .B = Math.Round(col.B, w)}
  506. End Function
  507. ''' <summary>
  508. ''' 获取两数间的百分比。小数点精确到 6 位。
  509. ''' </summary>
  510. ''' <returns></returns>
  511. Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double
  512. Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误
  513. End Function
  514. ''' <summary>
  515. ''' 获取两颜色间的百分比,根据 RGB 计算。小数点精确到 6 位。
  516. ''' </summary>
  517. Public Function MathPercent(ValueA As MyColor, ValueB As MyColor, Percent As Double) As MyColor
  518. Return MathRound(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决Double计算错误
  519. End Function
  520. ''' <summary>
  521. ''' 将数值限定在某个范围内。
  522. ''' </summary>
  523. Public Function MathClamp(value As Double, min As Double, max As Double) As Double
  524. Return Math.Max(min, Math.Min(max, value))
  525. End Function
  526. ''' <summary>
  527. ''' 符号函数。
  528. ''' </summary>
  529. Public Function MathSgn(Value As Double) As Integer
  530. If Value = 0 Then
  531. Return 0
  532. ElseIf Value > 0 Then
  533. Return 1
  534. Else
  535. Return -1
  536. End If
  537. End Function
  538. #End Region
  539. #Region "文件"
  540. '注册表
  541. ''' <summary>
  542. ''' 重命名一个注册表子键。不可用于包含子键的子键。
  543. ''' </summary>
  544. Public Sub RenameReg(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String)
  545. If parentKey.GetSubKeyNames().Contains(newSubKeyName) Then parentKey.DeleteSubKeyTree(newSubKeyName, False)
  546. Dim SourceKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(subKeyName)
  547. If IsNothing(SourceKey) Then Exit Sub '没有目标项
  548. Dim NewKey As Microsoft.Win32.RegistryKey = parentKey.CreateSubKey(newSubKeyName)
  549. If SourceKey.GetSubKeyNames().Length > 0 Then Throw New NotSupportedException("不支持对包含子键的子键进行重命名:" & SourceKey.GetSubKeyNames()(0) & "。")
  550. For Each valueName As String In SourceKey.GetValueNames()
  551. Dim objValue As Object = SourceKey.GetValue(valueName)
  552. Dim valKind As Microsoft.Win32.RegistryValueKind = SourceKey.GetValueKind(valueName)
  553. NewKey.SetValue(valueName, objValue, valKind)
  554. Next
  555. parentKey.DeleteSubKeyTree(subKeyName, False)
  556. End Sub
  557. ''' <summary>
  558. ''' 读取程序所属注册表。
  559. ''' </summary>
  560. Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
  561. Try
  562. Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
  563. parentKey = My.Computer.Registry.CurrentUser
  564. softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
  565. If softKey Is Nothing Then
  566. ReadReg = DefaultValue '不存在则返回默认值
  567. Else
  568. Dim readValue As New Text.StringBuilder
  569. readValue.AppendLine(softKey.GetValue(Key))
  570. Dim value = readValue.ToString.Replace(vbCrLf, "") '去除莫名的回车
  571. Return If(value = "", DefaultValue, value) '错误则返回默认值
  572. End If
  573. Catch ex As Exception
  574. Log(ex, "读取注册表出错:" & Key, LogLevel.Hint)
  575. Return DefaultValue
  576. End Try
  577. End Function
  578. ''' <summary>
  579. ''' 写入程序所属注册表。
  580. ''' </summary>
  581. Public Sub WriteReg(Key As String, Value As String, Optional ShowException As Boolean = False)
  582. Try
  583. Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey
  584. parentKey = My.Computer.Registry.CurrentUser
  585. softKey = parentKey.OpenSubKey("Software\" & RegFolder, True)
  586. If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\" & RegFolder) '如果不存在就创建
  587. softKey.SetValue(Key, Value)
  588. Catch ex As Exception
  589. Log(ex, "写入注册表出错:" & Key, If(ShowException, LogLevel.Hint, LogLevel.Developer))
  590. If ShowException Then Throw '如果显示错误就丢一个
  591. End Try
  592. End Sub
  593. 'Ini 文件
  594. Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
  595. ''' <summary>
  596. ''' 清除某 ini 文件的运行时缓存。
  597. ''' </summary>
  598. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  599. Public Sub IniClearCache(FileName As String)
  600. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  601. If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
  602. End Sub
  603. ''' <summary>
  604. ''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
  605. ''' 在文件不存在或读取失败时返回 Nothing。
  606. ''' </summary>
  607. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  608. Private Function IniGetContent(FileName As String) As Dictionary(Of String, String)
  609. Try
  610. '还原文件路径
  611. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  612. '检索缓存
  613. If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
  614. '读取文件
  615. If Not File.Exists(FileName) Then Return Nothing
  616. Dim Ini As New Dictionary(Of String, String)
  617. For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
  618. Dim Index As Integer = Line.IndexOfF(":")
  619. If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
  620. Next
  621. IniCache(FileName) = Ini
  622. Return Ini
  623. Catch ex As Exception
  624. Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
  625. Return Nothing
  626. End Try
  627. End Function
  628. ''' <summary>
  629. ''' 读取 ini 文件。这可能会使用到缓存。
  630. ''' </summary>
  631. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  632. ''' <param name="Key">键。</param>
  633. ''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
  634. Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
  635. Dim Content = IniGetContent(FileName)
  636. If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
  637. Return Content(Key)
  638. End Function
  639. ''' <summary>
  640. ''' 写入 ini 文件,这会更新缓存。
  641. ''' </summary>
  642. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  643. ''' <param name="Key">键。</param>
  644. ''' <param name="Value">值。</param>
  645. ''' <remarks></remarks>
  646. Public Sub WriteIni(FileName As String, Key As String, Value As String)
  647. Try
  648. '预处理
  649. Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
  650. Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
  651. '获取目前文件
  652. Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
  653. If Content Is Nothing Then Content = New Dictionary(Of String, String)
  654. If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
  655. '更新缓存
  656. Content(Key) = Value
  657. '写入文件
  658. Dim FileContent As New StringBuilder
  659. For Each Pair In Content
  660. FileContent.Append(Pair.Key)
  661. FileContent.Append(":")
  662. FileContent.Append(Pair.Value)
  663. FileContent.Append(vbCrLf)
  664. Next
  665. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  666. WriteFile(FileName, FileContent.ToString)
  667. Catch ex As Exception
  668. Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogLevel.Hint)
  669. End Try
  670. End Sub
  671. '路径处理
  672. ''' <summary>
  673. ''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
  674. ''' 取决于原路径格式,路径以 / 或 \ 结尾。
  675. ''' 不包含路径将会抛出异常。
  676. ''' </summary>
  677. Public Function GetPathFromFullPath(FilePath As String) As String
  678. If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath)
  679. If FilePath.EndsWithF("\") OrElse FilePath.EndsWithF("/") Then
  680. '是文件夹路径
  681. Dim IsRight As Boolean = FilePath.EndsWithF("\")
  682. FilePath = Left(FilePath, Len(FilePath) - 1)
  683. GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
  684. If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
  685. Else
  686. '是文件路径
  687. GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"}) + 1)
  688. If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
  689. End If
  690. End Function
  691. ''' <summary>
  692. ''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。
  693. ''' </summary>
  694. Public Function GetFileNameFromPath(FilePath As String) As String
  695. FilePath = FilePath.Replace("/", "\")
  696. If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
  697. If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
  698. If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
  699. Dim length As Integer = FilePath.Length
  700. If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
  701. If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
  702. Return FilePath
  703. End Function
  704. ''' <summary>
  705. ''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
  706. ''' </summary>
  707. Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
  708. Dim Name As String = GetFileNameFromPath(FilePath)
  709. If Name.Contains(".") Then
  710. Return Name.Substring(0, Name.LastIndexOfF("."))
  711. Else
  712. Return Name
  713. End If
  714. End Function
  715. ''' <summary>
  716. ''' 从文件夹路径获取文件夹名。
  717. ''' </summary>
  718. Public Function GetFolderNameFromPath(FolderPath As String) As String
  719. If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
  720. If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
  721. Return GetFileNameFromPath(FolderPath)
  722. End Function
  723. '读取、写入、复制文件
  724. Public Sub CopyFile(FromPath As String, ToPath As String)
  725. Try
  726. '还原文件路径
  727. If Not FromPath.Contains(":\") Then FromPath = Path & FromPath
  728. If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
  729. '如果复制同一个文件则跳过
  730. If FromPath = ToPath Then Exit Sub
  731. '确保目录存在
  732. Directory.CreateDirectory(GetPathFromFullPath(ToPath))
  733. '复制文件
  734. File.Copy(FromPath, ToPath, True)
  735. Catch ex As Exception
  736. Throw New Exception("复制文件出错:" & FromPath & " → " & ToPath, ex)
  737. End Try
  738. End Sub
  739. ''' <summary>
  740. ''' 读取文件,如果失败则返回空数组。
  741. ''' </summary>
  742. ''' <param name="FilePath">文件完整或相对路径。</param>
  743. Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
  744. Try
  745. '还原文件路径
  746. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  747. If File.Exists(FilePath) Then
  748. Dim FileBytes As Byte()
  749. Using ReadStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
  750. ReDim FileBytes(ReadStream.Length - 1)
  751. ReadStream.Read(FileBytes, 0, ReadStream.Length)
  752. End Using
  753. Return FileBytes
  754. Else
  755. Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
  756. Return {}
  757. End If
  758. Catch ex As Exception
  759. Log(ex, "读取文件出错:" & FilePath)
  760. Return {}
  761. End Try
  762. End Function
  763. ''' <summary>
  764. ''' 读取文件,如果失败则返回空字符串。
  765. ''' </summary>
  766. ''' <param name="FilePath">文件完整或相对路径。</param>
  767. Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
  768. Dim FileBytes = ReadFileBytes(FilePath)
  769. ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
  770. End Function
  771. ''' <summary>
  772. ''' 读取流中的所有文本。
  773. ''' </summary>
  774. Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
  775. Try
  776. Dim srcBuf As Byte() = New Byte(16384) {}
  777. Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
  778. Dim Result As New List(Of Byte)
  779. While DataCount > 0
  780. If DataCount > 0 Then Result.AddRange(srcBuf.ToList.GetRange(0, DataCount))
  781. DataCount = Stream.Read(srcBuf, 0, 16384)
  782. End While
  783. Dim Bts = Result.ToArray
  784. Return If(Encoding, GetEncoding(Bts)).GetString(Bts)
  785. Catch ex As Exception
  786. Log(ex, "读取流出错")
  787. Return ""
  788. End Try
  789. End Function
  790. ''' <summary>
  791. ''' 写入文件。
  792. ''' </summary>
  793. ''' <param name="FilePath">文件完整或相对路径。</param>
  794. ''' <param name="Text">文件内容。</param>
  795. ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
  796. Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
  797. '还原文件路径
  798. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  799. '确保目录存在
  800. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  801. '写入文件
  802. If File.Exists(FilePath) Then
  803. '如果文件存在,刷新目前文件
  804. Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
  805. writer.Write(Text)
  806. writer.Flush()
  807. writer.Close()
  808. End Using
  809. Else
  810. '如果文件不存在,则新建并写入
  811. File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
  812. End If
  813. End Sub
  814. ''' <summary>
  815. ''' 写入文件。
  816. ''' 如果 CanThrow 设置为 False,返回是否写入成功。
  817. ''' </summary>
  818. ''' <param name="FilePath">文件完整或相对路径。</param>
  819. ''' <param name="Content">文件内容。</param>
  820. ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
  821. Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
  822. '还原文件路径
  823. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  824. '确保目录存在
  825. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  826. '写入文件
  827. File.WriteAllBytes(FilePath, Content)
  828. End Sub
  829. ''' <summary>
  830. ''' 将流写入文件。
  831. ''' </summary>
  832. ''' <param name="FilePath">文件完整或相对路径。</param>
  833. Public Function WriteFile(FilePath As String, Stream As Stream) As Boolean
  834. Try
  835. '还原文件路径
  836. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  837. '确保目录存在
  838. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  839. '读取流
  840. Using fs As New FileStream(FilePath, FileMode.Create, FileAccess.Write)
  841. Dim srcBuf As Byte() = New Byte(16384) {}
  842. Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
  843. While DataCount > 0
  844. If DataCount > 0 Then fs.Write(srcBuf, 0, DataCount)
  845. DataCount = Stream.Read(srcBuf, 0, 16384)
  846. End While
  847. fs.Close()
  848. End Using
  849. Return True
  850. Catch ex As Exception
  851. Log(ex, "保存流出错")
  852. Return False
  853. End Try
  854. End Function
  855. '文件编码
  856. ''' <summary>
  857. ''' 根据字节数组分析其编码。
  858. ''' </summary>
  859. Public Function GetEncoding(Bytes As Byte()) As Encoding
  860. Dim Length As Integer = Bytes.Count
  861. If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  862. '根据 BOM 判断编码
  863. If Bytes(0) >= &HEF Then
  864. '有 BOM 类型
  865. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  866. Return New UTF8Encoding(True) '带 BOM 的 UTF8
  867. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  868. Return Encoding.BigEndianUnicode
  869. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  870. Return Encoding.Unicode
  871. Else
  872. Return Encoding.GetEncoding("GB18030")
  873. End If
  874. End If
  875. '无 BOM 文件:GB18030(ANSI)或 UTF8
  876. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  877. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  878. If UTF8.Contains(ErrorChar) Then
  879. Return Encoding.GetEncoding("GB18030")
  880. Else
  881. Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  882. End If
  883. End Function
  884. ''' <summary>
  885. ''' 解码 Bytes。
  886. ''' </summary>
  887. Public Function DecodeBytes(Bytes As Byte()) As String
  888. Dim Length As Integer = Bytes.Length
  889. If Length < 3 Then Return Encoding.UTF8.GetString(Bytes)
  890. '根据 BOM 判断编码
  891. If Bytes(0) >= &HEF Then
  892. '有 BOM 类型
  893. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  894. Return Encoding.UTF8.GetString(Bytes, 3, Length - 3)
  895. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  896. Return Encoding.BigEndianUnicode.GetString(Bytes, 3, Length - 3)
  897. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  898. Return Encoding.Unicode.GetString(Bytes, 3, Length - 3)
  899. Else
  900. Return Encoding.GetEncoding("GB18030").GetString(Bytes, 3, Length - 3)
  901. End If
  902. End If
  903. '无 BOM 文件:GB18030(ANSI)或 UTF8
  904. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  905. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  906. If UTF8.Contains(ErrorChar) Then
  907. Return Encoding.GetEncoding("GB18030").GetString(Bytes)
  908. Else
  909. Return UTF8
  910. End If
  911. End Function
  912. '对话框
  913. ''' <summary>
  914. ''' 弹出保存对话框并且要求保存位置,返回用户输入的完整路径。
  915. ''' </summary>
  916. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  917. ''' <param name="Title">弹窗的标题。</param>
  918. ''' <param name="FileName">默认的文件名。</param>
  919. Public Function SelectAs(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional DefaultDir As String = Nothing) As String
  920. Using fileDialog As New Forms.SaveFileDialog
  921. fileDialog.AddExtension = True
  922. fileDialog.AutoUpgradeEnabled = True
  923. fileDialog.Title = Title
  924. fileDialog.FileName = FileName
  925. If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
  926. If DefaultDir IsNot Nothing Then fileDialog.InitialDirectory = DefaultDir
  927. fileDialog.ShowDialog()
  928. SelectAs = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
  929. Log("[UI] 选择文件返回:" & SelectAs)
  930. End Using
  931. End Function
  932. ''' <summary>
  933. ''' 弹出选取文件对话框并且要求选取文件。
  934. ''' </summary>
  935. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  936. ''' <param name="Title">弹窗的标题。</param>
  937. Public Function SelectFile(FileFilter As String, Title As String) As String
  938. Using fileDialog As New Forms.OpenFileDialog
  939. fileDialog.AddExtension = True
  940. fileDialog.AutoUpgradeEnabled = True
  941. fileDialog.CheckFileExists = True
  942. fileDialog.Filter = FileFilter
  943. fileDialog.Multiselect = False
  944. fileDialog.Title = Title
  945. fileDialog.ValidateNames = True
  946. fileDialog.ShowDialog()
  947. SelectFile = fileDialog.FileName
  948. Log("[UI] 选择文件返回:" & SelectFile)
  949. End Using
  950. End Function
  951. ''' <summary>
  952. ''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。
  953. ''' </summary>
  954. Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
  955. Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
  956. folderDialog.ShowDialog()
  957. SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
  958. Log("[UI] 选择文件夹返回:" & SelectFolder)
  959. End Function
  960. '文件校验
  961. ''' <summary>
  962. ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在,会返回 False。
  963. ''' </summary>
  964. Public Function CheckPermission(Path As String) As Boolean
  965. Try
  966. If String.IsNullOrEmpty(Path) Then Return False
  967. If Not Path.EndsWithF("\") Then Path += "\"
  968. If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
  969. If Not Directory.Exists(Path) Then Return False
  970. Dim FileName As String = "CheckPermission" & GetUuid()
  971. If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
  972. File.Create(Path & FileName).Dispose()
  973. File.Delete(Path & FileName)
  974. Return True
  975. Catch ex As Exception
  976. Log(ex, "没有对文件夹 " & Path & " 的权限,请尝试以管理员权限运行 PCL")
  977. Return False
  978. End Try
  979. End Function
  980. ''' <summary>
  981. ''' 检查是否拥有某一文件夹的 I/O 权限。如果出错,则抛出异常。
  982. ''' </summary>
  983. Public Sub CheckPermissionWithException(Path As String)
  984. If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!")
  985. If Not Path.EndsWithF("\") Then Path += "\"
  986. If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
  987. If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
  988. File.Create(Path & "CheckPermission").Dispose()
  989. File.Delete(Path & "CheckPermission")
  990. End Sub
  991. ''' <summary>
  992. ''' 获取文件 MD5,若失败则返回空字符串。
  993. ''' </summary>
  994. Public Function GetFileMD5(FilePath As String) As String
  995. Dim Retry As Boolean = False
  996. Re:
  997. Try
  998. '获取 MD5
  999. Dim Result As New StringBuilder()
  1000. Dim File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1001. Dim MD5 As MD5 = New MD5CryptoServiceProvider()
  1002. Dim Retval As Byte() = MD5.ComputeHash(File)
  1003. File.Close()
  1004. For i = 0 To Retval.Length - 1
  1005. Result.Append(Retval(i).ToString("x2"))
  1006. Next
  1007. Return Result.ToString
  1008. Catch ex As Exception
  1009. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1010. Log(ex, "获取文件 MD5 失败:" & FilePath)
  1011. Return ""
  1012. Else
  1013. Retry = True
  1014. Log(ex, "获取文件 MD5 可重试失败:" & FilePath, LogLevel.Normal)
  1015. Thread.Sleep(RandomInteger(200, 500))
  1016. GoTo Re
  1017. End If
  1018. End Try
  1019. End Function
  1020. ''' <summary>
  1021. ''' 获取文件 SHA256,若失败则返回空字符串。
  1022. ''' </summary>
  1023. Public Function GetFileSHA256(FilePath As String) As String
  1024. Dim Retry As Boolean = False
  1025. Re:
  1026. Try
  1027. ''检测该文件是否在下载中,若在下载则放弃检测
  1028. 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
  1029. '获取 SHA256
  1030. Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1031. Dim sha1 As SHA256 = New SHA256CryptoServiceProvider()
  1032. Dim retval As Byte() = sha1.ComputeHash(file)
  1033. file.Close()
  1034. Dim Result As New StringBuilder()
  1035. For i As Integer = 0 To retval.Length - 1
  1036. Result.Append(retval(i).ToString("x2"))
  1037. Next
  1038. Return Result.ToString
  1039. Catch ex As Exception
  1040. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1041. Log(ex, "获取文件 SHA256 失败:" & FilePath)
  1042. Return ""
  1043. Else
  1044. Retry = True
  1045. Log(ex, "获取文件 SHA256 可重试失败:" & FilePath, LogLevel.Normal)
  1046. Thread.Sleep(RandomInteger(200, 500))
  1047. GoTo Re
  1048. End If
  1049. End Try
  1050. End Function
  1051. ''' <summary>
  1052. ''' 获取文件 SHA1,若失败则返回空字符串。
  1053. ''' </summary>
  1054. Public Function GetFileSHA1(FilePath As String) As String
  1055. Dim Retry As Boolean = False
  1056. Re:
  1057. Try
  1058. '获取 SHA1
  1059. Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1060. Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
  1061. Dim retval As Byte() = sha1.ComputeHash(file)
  1062. file.Close()
  1063. Dim Result As New StringBuilder()
  1064. For i As Integer = 0 To retval.Length - 1
  1065. Result.Append(retval(i).ToString("x2"))
  1066. Next
  1067. Return Result.ToString
  1068. Catch ex As Exception
  1069. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1070. Log(ex, "获取文件 SHA1 失败:" & FilePath)
  1071. Return ""
  1072. Else
  1073. Retry = True
  1074. Log(ex, "获取文件 SHA1 可重试失败:" & FilePath, LogLevel.Normal)
  1075. Thread.Sleep(RandomInteger(200, 500))
  1076. GoTo Re
  1077. End If
  1078. End Try
  1079. End Function
  1080. ''' <summary>
  1081. ''' 获取流 SHA1,若失败则返回空字符串。
  1082. ''' </summary>
  1083. Public Function GetAuthSHA1(Stream As Stream) As String
  1084. Try
  1085. Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
  1086. Dim retval As Byte() = sha1.ComputeHash(Stream)
  1087. Dim Result As New StringBuilder()
  1088. For i As Integer = 0 To retval.Length - 1
  1089. Result.Append(retval(i).ToString("x2"))
  1090. Next
  1091. Return Result.ToString
  1092. Catch ex As Exception
  1093. Log(ex, "获取流 SHA1 失败")
  1094. Return ""
  1095. End Try
  1096. End Function
  1097. ''' <summary>
  1098. ''' 文件的校验规则。
  1099. ''' </summary>
  1100. Public Class FileChecker
  1101. ''' <summary>
  1102. ''' 文件的准确大小。
  1103. ''' </summary>
  1104. Public ActualSize As Long = -1
  1105. ''' <summary>
  1106. ''' 文件的最小大小。
  1107. ''' </summary>
  1108. Public MinSize As Long = -1
  1109. ''' <summary>
  1110. ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
  1111. ''' </summary>
  1112. Public Hash As String = Nothing
  1113. ''' <summary>
  1114. ''' 是否可以使用已经存在的文件。
  1115. ''' </summary>
  1116. Public CanUseExistsFile As Boolean = True
  1117. ''' <summary>
  1118. ''' 是否为 Json 文件。
  1119. ''' </summary>
  1120. Public IsJson As Boolean = False
  1121. Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
  1122. Me.ActualSize = ActualSize
  1123. Me.MinSize = MinSize
  1124. Me.Hash = Hash
  1125. Me.CanUseExistsFile = CanUseExistsFile
  1126. Me.IsJson = IsJson
  1127. End Sub
  1128. ''' <summary>
  1129. ''' 检查文件。若成功则返回 Nothing,失败则返回错误的描述文本,描述文本不以句号结尾。不会抛出错误。
  1130. ''' </summary>
  1131. Public Function Check(LocalPath As String) As String
  1132. Try
  1133. Dim Info As New FileInfo(LocalPath)
  1134. If Not Info.Exists Then Return "文件不存在:" & LocalPath
  1135. Dim FileSize As Long = Info.Length
  1136. If ActualSize >= 0 AndAlso ActualSize <> FileSize Then Return "文件大小应为 " & ActualSize & " B,实际为 " & FileSize & " B"
  1137. If MinSize >= 0 AndAlso MinSize > FileSize Then Return "文件大小应大于 " & MinSize & " B,实际为 " & FileSize & " B"
  1138. If Not String.IsNullOrEmpty(Hash) Then
  1139. If Hash.Length < 35 Then 'MD5
  1140. If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
  1141. ElseIf Hash.Length = 64 Then 'SHA256
  1142. If Hash.ToLowerInvariant <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
  1143. Else 'SHA1 (40)
  1144. If Hash.ToLowerInvariant <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
  1145. End If
  1146. End If
  1147. If IsJson Then
  1148. Dim Content As String = ReadFile(LocalPath)
  1149. If Content = "" Then Throw New Exception("读取到的文件为空")
  1150. Try
  1151. GetJson(Content)
  1152. Catch ex As Exception
  1153. Throw New Exception("不是有效的 json 文件", ex)
  1154. End Try
  1155. End If
  1156. Return Nothing
  1157. Catch ex As Exception
  1158. Log(ex, "检查文件出错")
  1159. Return GetExceptionSummary(ex)
  1160. End Try
  1161. End Function
  1162. End Class
  1163. ''' <summary>
  1164. ''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
  1165. ''' 会尝试创建,但不会清空目标文件夹。
  1166. ''' </summary>
  1167. Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
  1168. Directory.CreateDirectory(DestDirectory)
  1169. If CompressFilePath.EndsWithF(".gz", True) Then
  1170. '以 gz 方式解压
  1171. Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
  1172. Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
  1173. Dim data As Integer = stream.ReadByte()
  1174. While data <> -1
  1175. decompressedFile.WriteByte(data)
  1176. data = stream.ReadByte()
  1177. End While
  1178. decompressedFile.Close()
  1179. stream.Close()
  1180. Else
  1181. '以 zip 方式解压
  1182. Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
  1183. For Each Entry As ZipArchiveEntry In Archive.Entries
  1184. Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
  1185. If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
  1186. Continue For '不创建空文件夹
  1187. Else
  1188. Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
  1189. Entry.ExtractToFile(DestinationPath, True)
  1190. End If
  1191. Next
  1192. End Using
  1193. End If
  1194. End Sub
  1195. ''' <summary>
  1196. ''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
  1197. ''' </summary>
  1198. Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
  1199. If Not Directory.Exists(Path) Then Return 0
  1200. Dim DeletedCount As Integer = 0
  1201. Dim Files As String()
  1202. Try
  1203. Files = Directory.GetFiles(Path)
  1204. Catch ex As DirectoryNotFoundException '#4549
  1205. Log(ex, $"疑似为孤立符号链接,尝试直接删除({Path})", LogLevel.Developer)
  1206. Directory.Delete(Path)
  1207. Return 0
  1208. End Try
  1209. For Each FilePath As String In Files
  1210. Dim RetriedFile As Boolean = False
  1211. RetryFile:
  1212. Try
  1213. File.Delete(FilePath)
  1214. DeletedCount += 1
  1215. Catch ex As Exception
  1216. If Not RetriedFile Then
  1217. RetriedFile = True
  1218. Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
  1219. Thread.Sleep(300)
  1220. GoTo RetryFile
  1221. ElseIf IgnoreIssue Then
  1222. Log(ex, "删除单个文件可忽略地失败")
  1223. Else
  1224. Throw
  1225. End If
  1226. End Try
  1227. Next
  1228. For Each str As String In Directory.GetDirectories(Path)
  1229. DeleteDirectory(str, IgnoreIssue)
  1230. Next
  1231. Dim RetriedDir As Boolean = False
  1232. RetryDir:
  1233. Try
  1234. Directory.Delete(Path, True)
  1235. Catch ex As Exception
  1236. If Not RetriedDir Then
  1237. RetriedDir = True
  1238. Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
  1239. Thread.Sleep(300)
  1240. GoTo RetryDir
  1241. ElseIf IgnoreIssue Then
  1242. Log(ex, "删除单个文件夹可忽略地失败")
  1243. Else
  1244. Throw
  1245. End If
  1246. End Try
  1247. Return DeletedCount
  1248. End Function
  1249. ''' <summary>
  1250. ''' 复制文件夹,失败会抛出异常。
  1251. ''' </summary>
  1252. Public Sub CopyDirectory(FromPath As String, ToPath As String)
  1253. FromPath = FromPath.Replace("/", "\")
  1254. If Not FromPath.EndsWithF("\") Then FromPath &= "\"
  1255. ToPath = ToPath.Replace("/", "\")
  1256. If Not ToPath.EndsWithF("\") Then ToPath &= "\"
  1257. For Each File In EnumerateFiles(FromPath)
  1258. CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
  1259. Next
  1260. End Sub
  1261. ''' <summary>
  1262. ''' 遍历文件夹中的所有文件。
  1263. ''' </summary>
  1264. Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
  1265. Dim Info As New DirectoryInfo(Directory)
  1266. If Not Info.Exists Then Return New List(Of FileInfo)
  1267. Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
  1268. End Function
  1269. #End Region
  1270. #Region "文本"
  1271. Public vbLQ As Char = Convert.ToChar(8220)
  1272. Public vbRQ As Char = Convert.ToChar(8221)
  1273. ''' <summary>
  1274. ''' 提取 Exception 的具体描述与堆栈。
  1275. ''' </summary>
  1276. ''' <param name="ShowAllTrace">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
  1277. Public Function GetExceptionDetail(Ex As Exception, Optional ShowAllTrace As Boolean = False) As String
  1278. If Ex Is Nothing Then Return "无可用错误信息!"
  1279. '获取最底层的异常
  1280. Dim InnerEx As Exception = Ex
  1281. Do Until InnerEx.InnerException Is Nothing
  1282. InnerEx = InnerEx.InnerException
  1283. Loop
  1284. '获取各级错误的描述与堆栈信息
  1285. Dim DescList As New List(Of String)
  1286. Dim StackList As New List(Of String)
  1287. Do Until Ex Is Nothing
  1288. DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
  1289. If Ex.StackTrace IsNot Nothing Then
  1290. For Each St As String In Ex.StackTrace.Split(vbCrLf)
  1291. If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then StackList.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
  1292. Next
  1293. End If
  1294. Ex = Ex.InnerException
  1295. Loop
  1296. DescList = DescList.Distinct.ToList
  1297. Dim Desc As String = Join(DescList, vbCrLf & "→ ")
  1298. Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")
  1299. '常见错误(记得同时修改下面的)
  1300. Dim CommonReason As String = Nothing
  1301. If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
  1302. CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
  1303. ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
  1304. CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
  1305. ElseIf TypeOf InnerEx Is OutOfMemoryException Then
  1306. CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
  1307. ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
  1308. CommonReason = "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
  1309. ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
  1310. "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
  1311. CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
  1312. End If
  1313. '获取错误类型
  1314. Dim TypeDesc As String = If(InnerEx.GetType.FullName = "System.Exception", "", vbCrLf & "错误类型:" & InnerEx.GetType.FullName)
  1315. '构造输出信息
  1316. If CommonReason Is Nothing Then
  1317. Return Desc & Stack & TypeDesc
  1318. Else
  1319. Dim Result As String = DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf
  1320. DescList(0) = "详细错误信息:"
  1321. Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc
  1322. End If
  1323. End Function
  1324. ''' <summary>
  1325. ''' 提取 Exception 描述,汇总到一行。
  1326. ''' </summary>
  1327. Public Function GetExceptionSummary(Ex As Exception) As String
  1328. If Ex Is Nothing Then Return "无可用错误信息!"
  1329. '获取最底层的异常
  1330. Dim InnerEx As Exception = Ex
  1331. Do Until InnerEx.InnerException Is Nothing
  1332. InnerEx = InnerEx.InnerException
  1333. Loop
  1334. '获取各级错误的描述
  1335. Dim DescList As New List(Of String)
  1336. Do Until Ex Is Nothing
  1337. DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
  1338. Ex = Ex.InnerException
  1339. Loop
  1340. DescList = DescList.Distinct.ToList
  1341. Dim Desc As String = Join(DescList, vbCrLf & "→ ")
  1342. '常见错误(记得同时修改上面的)
  1343. Dim CommonReason As String = Nothing
  1344. If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
  1345. CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
  1346. ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
  1347. CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
  1348. ElseIf TypeOf InnerEx Is OutOfMemoryException Then
  1349. CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
  1350. ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
  1351. CommonReason = "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
  1352. ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
  1353. "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
  1354. CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
  1355. End If
  1356. '构造输出信息
  1357. If CommonReason IsNot Nothing Then
  1358. Return DescList.First & ":" & CommonReason
  1359. Else
  1360. DescList.Reverse() '让最深层错误在最左边
  1361. Return Join(DescList, " → ")
  1362. End If
  1363. End Function
  1364. ''' <summary>
  1365. ''' 返回一个枚举对应的字符串。
  1366. ''' </summary>
  1367. ''' <param name="EnumData">一个已经实例化的枚举类型。</param>
  1368. Public Function GetStringFromEnum(EnumData As [Enum]) As String
  1369. Return [Enum].GetName(EnumData.GetType, EnumData)
  1370. End Function
  1371. ''' <summary>
  1372. ''' 将文件大小转化为适合的文本形式,如“1.28 M”。
  1373. ''' </summary>
  1374. ''' <param name="FileSize">以字节为单位的大小表示。</param>
  1375. Public Function GetString(FileSize As Long) As String
  1376. Dim IsNegative = FileSize < 0
  1377. If IsNegative Then FileSize *= -1
  1378. If FileSize < 1000 Then
  1379. 'B 级
  1380. Return If(IsNegative, "-", "") & FileSize & " B"
  1381. ElseIf FileSize < 1024 * 1000 Then
  1382. 'K 级
  1383. Dim RoundResult As String = Math.Round(FileSize / 1024)
  1384. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " K"
  1385. ElseIf FileSize < 1024 * 1024 * 1000 Then
  1386. 'M 级
  1387. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
  1388. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " M"
  1389. Else
  1390. 'G 级
  1391. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
  1392. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " G"
  1393. End If
  1394. End Function
  1395. ''' <summary>
  1396. ''' 获取 JSON 对象。
  1397. ''' </summary>
  1398. Public Function GetJson(Data As String)
  1399. Try
  1400. Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
  1401. Catch ex As Exception
  1402. Dim Length As Integer = If(Data, "").Length
  1403. Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
  1404. End Try
  1405. End Function
  1406. ''' <summary>
  1407. ''' 将第一个字符转换为大写,其余字符转换为小写。
  1408. ''' </summary>
  1409. <Extension> Public Function Capitalize(word As String) As String
  1410. If String.IsNullOrEmpty(word) Then Return word
  1411. Return word.Substring(0, 1).ToUpperInvariant() & word.Substring(1).ToLowerInvariant()
  1412. End Function
  1413. ''' <summary>
  1414. ''' 将字符串统一至某个长度,过短则以 Code 将其右侧填充,过长则截取靠左的指定长度。
  1415. ''' </summary>
  1416. Public Function StrFill(Str As String, Code As String, Length As Byte) As String
  1417. If Str.Length > Length Then Return Mid(Str, 1, Length)
  1418. Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str
  1419. End Function
  1420. ''' <summary>
  1421. ''' 将一个小数显示为固定的小数点后位数形式,将向零取整。
  1422. ''' 如 12 保留 2 位则输出 12.00,而 95.678 保留 2 位则输出 95.67。
  1423. ''' </summary>
  1424. Public Function StrFillNum(Num As Double, Length As Integer) As String
  1425. Num = Math.Round(Num, Length, MidpointRounding.AwayFromZero)
  1426. StrFillNum = Num
  1427. If Not StrFillNum.Contains(".") Then Return (StrFillNum & ".").PadRight(StrFillNum.Length + 1 + Length, "0")
  1428. Return StrFillNum.PadRight(StrFillNum.Split(".")(0).Length + 1 + Length, "0")
  1429. End Function
  1430. ''' <summary>
  1431. ''' 移除字符串首尾的标点符号、回车,以及括号中、冒号后的补充说明内容。
  1432. ''' </summary>
  1433. Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True)
  1434. If RemoveQuote Then Str = Str.Split("(")(0).Split(":")(0).Split("(")(0).Split(":")(0)
  1435. Return Str.Trim(".", "。", "!", " ", "!", "?", "?", vbCr, vbLf)
  1436. End Function
  1437. ''' <summary>
  1438. ''' 连接字符串。
  1439. ''' </summary>
  1440. <Extension> Public Function Join(List As IEnumerable, Split As String) As String
  1441. Dim Builder As New StringBuilder
  1442. Dim IsFirst As Boolean = True
  1443. For Each Element In List
  1444. If IsFirst Then
  1445. IsFirst = False
  1446. Else
  1447. Builder.Append(Split)
  1448. End If
  1449. If Element IsNot Nothing Then Builder.Append(Element)
  1450. Next
  1451. Return Builder.ToString
  1452. End Function
  1453. ''' <summary>
  1454. ''' 分割字符串。
  1455. ''' </summary>
  1456. <Extension> Public Function Split(FullStr As String, SplitStr As String) As String()
  1457. If SplitStr.Length = 1 Then
  1458. Return FullStr.Split(SplitStr(0))
  1459. Else
  1460. Return FullStr.Split({SplitStr}, StringSplitOptions.None)
  1461. End If
  1462. End Function
  1463. ''' <summary>
  1464. ''' 获取字符串哈希值。
  1465. ''' </summary>
  1466. Public Function GetHash(Str As String) As ULong
  1467. GetHash = 5381
  1468. For i = 0 To Str.Length - 1
  1469. GetHash = (GetHash << 5) Xor GetHash Xor CType(AscW(Str(i)), ULong)
  1470. Next
  1471. Return GetHash Xor &HA98F501BC684032FUL
  1472. End Function
  1473. ''' <summary>
  1474. ''' 获取字符串 MD5。
  1475. ''' </summary>
  1476. Public Function GetStringMD5(Str As String) As String
  1477. Dim md5Hasher As New MD5CryptoServiceProvider
  1478. Dim hashedDataBytes As Byte()
  1479. hashedDataBytes = md5Hasher.ComputeHash(Encoding.GetEncoding("gb2312").GetBytes(Str))
  1480. Dim tmp As New StringBuilder()
  1481. For Each i As Byte In hashedDataBytes
  1482. tmp.Append(i.ToString("x2"))
  1483. Next
  1484. Return tmp.ToString()
  1485. End Function
  1486. ''' <summary>
  1487. ''' 检查字符串中的字符是否均为 ASCII 字符。
  1488. ''' </summary>
  1489. <Extension> Public Function IsASCII(Input As String) As Boolean
  1490. Return Input.All(Function(c) AscW(c) < 128)
  1491. End Function
  1492. ''' <summary>
  1493. ''' 获取在子字符串之前的部分。
  1494. ''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
  1495. ''' </summary>
  1496. <Extension> Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1497. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
  1498. If Pos >= 0 Then
  1499. Return Str.Substring(0, Pos)
  1500. Else
  1501. Return Str
  1502. End If
  1503. End Function
  1504. ''' <summary>
  1505. ''' 获取在子字符串之后的部分。
  1506. ''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
  1507. ''' </summary>
  1508. <Extension> Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1509. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
  1510. If Pos >= 0 Then
  1511. Return Str.Substring(Pos + Text.Length)
  1512. Else
  1513. Return Str
  1514. End If
  1515. End Function
  1516. ''' <summary>
  1517. ''' 获取处于两个子字符串之间的部分。
  1518. ''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
  1519. ''' </summary>
  1520. <Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
  1521. Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
  1522. If StartPos >= 0 Then
  1523. StartPos += After.Length
  1524. Else
  1525. StartPos = 0
  1526. End If
  1527. Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
  1528. If EndPos >= 0 Then
  1529. Return Str.Substring(StartPos, EndPos - StartPos)
  1530. ElseIf StartPos > 0 Then
  1531. Return Str.Substring(StartPos)
  1532. Else
  1533. Return Str
  1534. End If
  1535. End Function
  1536. ''' <summary>
  1537. ''' 高速的 StartsWith。
  1538. ''' </summary>
  1539. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1540. Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
  1541. Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1542. End Function
  1543. ''' <summary>
  1544. ''' 高速的 EndsWith。
  1545. ''' </summary>
  1546. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1547. Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
  1548. Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1549. End Function
  1550. ''' <summary>
  1551. ''' 支持可变大小写判断的 Contains。
  1552. ''' </summary>
  1553. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1554. Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
  1555. Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
  1556. End Function
  1557. ''' <summary>
  1558. ''' 高速的 IndexOf。
  1559. ''' </summary>
  1560. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1561. Public Function IndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
  1562. Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1563. End Function
  1564. ''' <summary>
  1565. ''' 高速的 IndexOf。
  1566. ''' </summary>
  1567. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1568. Public Function IndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
  1569. Return Str.IndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1570. End Function
  1571. ''' <summary>
  1572. ''' 高速的 LastIndexOf。
  1573. ''' </summary>
  1574. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1575. Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
  1576. Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1577. End Function
  1578. ''' <summary>
  1579. ''' 高速的 LastIndexOf。
  1580. ''' </summary>
  1581. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1582. Public Function LastIndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
  1583. Return Str.LastIndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1584. End Function
  1585. ''' <summary>
  1586. ''' 不会报错的 Val。
  1587. ''' 如果输入有误,返回 0。
  1588. ''' </summary>
  1589. Public Function Val(Str As Object) As Double
  1590. Try
  1591. Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
  1592. Catch
  1593. Return 0
  1594. End Try
  1595. End Function
  1596. '转义
  1597. ''' <summary>
  1598. ''' 为字符串进行 XML 转义。
  1599. ''' </summary>
  1600. Public Function EscapeXML(Str As String) As String
  1601. If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
  1602. Return Str.
  1603. Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
  1604. Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
  1605. End Function
  1606. '正则
  1607. ''' <summary>
  1608. ''' 搜索字符串中的所有正则匹配项。
  1609. ''' </summary>
  1610. Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String)
  1611. Try
  1612. RegexSearch = New List(Of String)
  1613. Dim RegexSearchRes = New Regex(regex, options).Matches(str)
  1614. If RegexSearchRes Is Nothing Then Return RegexSearch
  1615. For Each item As Match In RegexSearchRes
  1616. RegexSearch.Add(item.Value)
  1617. Next
  1618. Catch ex As Exception
  1619. Log(ex, "正则匹配全部项出错")
  1620. Return New List(Of String)
  1621. End Try
  1622. End Function
  1623. ''' <summary>
  1624. ''' 获取字符串中的第一个正则匹配项,若无匹配则返回 Nothing。
  1625. ''' </summary>
  1626. Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
  1627. Try
  1628. Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value
  1629. Return If(Result = "", Nothing, Result)
  1630. Catch ex As Exception
  1631. Log(ex, "正则匹配第一项出错")
  1632. Return Nothing
  1633. End Try
  1634. End Function
  1635. ''' <summary>
  1636. ''' 检查字符串是否匹配某正则模式。
  1637. ''' </summary>
  1638. Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As Boolean
  1639. Try
  1640. Return RegularExpressions.Regex.IsMatch(str, regex, options)
  1641. Catch ex As Exception
  1642. Log(ex, "正则检查出错")
  1643. Return False
  1644. End Try
  1645. End Function
  1646. ''' <summary>
  1647. ''' 进行正则替换,会抛出错误。
  1648. ''' </summary>
  1649. Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
  1650. Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
  1651. End Function
  1652. ''' <summary>
  1653. ''' 对每个正则匹配分别进行替换,会抛出错误。
  1654. ''' </summary>
  1655. Public Function RegexReplaceEach(Input As String, Replacement As MatchEvaluator, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
  1656. Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
  1657. End Function
  1658. #End Region
  1659. #Region "搜索"
  1660. ''' <summary>
  1661. ''' 获取搜索文本的相似度。
  1662. ''' </summary>
  1663. ''' <param name="Source">被搜索的长内容。</param>
  1664. ''' <param name="Query">用户输入的搜索文本。</param>
  1665. Private Function SearchSimilarity(Source As String, Query As String) As Double
  1666. Dim qp As Integer = 0, lenSum As Double = 0
  1667. Source = Source.ToLower.Replace(" ", "")
  1668. Query = Query.ToLower.Replace(" ", "")
  1669. Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
  1670. Do While qp < queryLength
  1671. '对 qp 作为开始位置计算
  1672. Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
  1673. '查找以 qp 为头的最大子串
  1674. Do While sp < Source.Length
  1675. '对每个 sp 作为开始位置计算最大子串
  1676. Dim len As Integer = 0
  1677. Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
  1678. len += 1
  1679. Loop
  1680. '存储 len
  1681. If len > lenMax Then
  1682. lenMax = len
  1683. spMax = sp
  1684. End If
  1685. '根据结果增加 sp
  1686. sp += Math.Max(1, len)
  1687. Loop
  1688. If lenMax > 0 Then
  1689. Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
  1690. '存储 lenSum
  1691. Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
  1692. IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
  1693. lenSum += IncWeight
  1694. End If
  1695. '根据结果增加 qp
  1696. qp += Math.Max(1, lenMax)
  1697. Loop
  1698. '计算结果:重复字段量 × 源长度影响比例
  1699. Return (lenSum / queryLength) * (3 / Math.Pow(sourceLength + 15, 0.5)) * If(queryLength <= 2, 3 - queryLength, 1)
  1700. End Function
  1701. ''' <summary>
  1702. ''' 获取多段文本加权后的相似度。
  1703. ''' </summary>
  1704. Private Function SearchSimilarityWeighted(Source As List(Of KeyValuePair(Of String, Double)), Query As String) As Double
  1705. Dim TotalWeight As Double = 0
  1706. Dim Sum As Double = 0
  1707. For Each Pair In Source
  1708. Sum += SearchSimilarity(Pair.Key, Query) * Pair.Value
  1709. TotalWeight += Pair.Value
  1710. Next
  1711. Return Sum / TotalWeight
  1712. End Function
  1713. ''' <summary>
  1714. ''' 用于搜索的项目。
  1715. ''' </summary>
  1716. Public Class SearchEntry(Of T)
  1717. ''' <summary>
  1718. ''' 该项目对应的源数据。
  1719. ''' </summary>
  1720. Public Item As T
  1721. ''' <summary>
  1722. ''' 该项目用于搜索的源。
  1723. ''' </summary>
  1724. Public SearchSource As List(Of KeyValuePair(Of String, Double))
  1725. ''' <summary>
  1726. ''' 相似度。
  1727. ''' </summary>
  1728. Public Similarity As Double
  1729. ''' <summary>
  1730. ''' 是否完全匹配。
  1731. ''' </summary>
  1732. Public AbsoluteRight As Boolean
  1733. End Class
  1734. ''' <summary>
  1735. ''' 进行多段文本加权搜索,获取相似度较高的数项结果。
  1736. ''' </summary>
  1737. ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
  1738. ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
  1739. Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
  1740. '初始化
  1741. Dim ResultList As New List(Of SearchEntry(Of T))
  1742. If Not Entries.Any() Then Return ResultList
  1743. '进行搜索,获取相似信息
  1744. For Each Entry In Entries
  1745. Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
  1746. Entry.AbsoluteRight = False
  1747. For Each Pair In Entry.SearchSource
  1748. If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
  1749. Next
  1750. Next
  1751. '按照相似度进行排序
  1752. Entries = Sort(Entries,
  1753. Function(Left, Right) As Boolean
  1754. If Left.AbsoluteRight Xor Right.AbsoluteRight Then
  1755. Return Left.AbsoluteRight
  1756. Else
  1757. Return Left.Similarity > Right.Similarity
  1758. End If
  1759. End Function)
  1760. '返回结果
  1761. Dim BlurCount As Integer = 0
  1762. For Each Entry In Entries
  1763. If Entry.AbsoluteRight Then
  1764. ResultList.Add(Entry) '完全匹配,直接加入
  1765. Else
  1766. If Entry.Similarity < MinBlurSimilarity OrElse BlurCount = MaxBlurCount Then Exit For '模糊结果边界条件
  1767. ResultList.Add(Entry)
  1768. BlurCount += 1 '模糊结果计数
  1769. End If
  1770. Next
  1771. Return ResultList
  1772. End Function
  1773. #End Region
  1774. #Region "系统"
  1775. ''' <summary>
  1776. ''' 当前程序是否拥有管理员权限。
  1777. ''' </summary>
  1778. Public Function IsAdmin() As Boolean
  1779. Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
  1780. Dim principal As New WindowsPrincipal(id)
  1781. Return principal.IsInRole(WindowsBuiltInRole.Administrator)
  1782. End Function
  1783. ''' <summary>
  1784. ''' 以管理员权限运行当前程序,并等待程序运行结束。
  1785. ''' 返回程序的返回代码,如果运行失败将抛出异常。
  1786. ''' </summary>
  1787. Public Function RunAsAdmin(Argument As String) As Integer
  1788. Dim NewProcess = Process.Start(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument})
  1789. NewProcess.WaitForExit()
  1790. Return NewProcess.ExitCode
  1791. End Function
  1792. ''' <summary>
  1793. ''' 判断当前系统语言是否为中文。
  1794. ''' </summary>
  1795. Public Function IsSystemLanguageChinese() As Boolean
  1796. Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
  1797. End Function
  1798. Private Uuid As Integer = 1
  1799. Private UuidLock As Object
  1800. ''' <summary>
  1801. ''' 获取一个全程序内不会重复的数字(伪 Uuid)。
  1802. ''' </summary>
  1803. Public Function GetUuid() As Integer
  1804. If UuidLock Is Nothing Then UuidLock = New Object
  1805. SyncLock UuidLock
  1806. Uuid += 1
  1807. Return Uuid
  1808. End SyncLock
  1809. End Function
  1810. ''' <summary>
  1811. ''' 将元素与 List 的混合体拆分为元素组。
  1812. ''' </summary>
  1813. Public Function GetFullList(Of T)(data As IList) As List(Of T)
  1814. GetFullList = New List(Of T)
  1815. For i = 0 To data.Count - 1
  1816. If TypeOf data(i) Is ICollection Then
  1817. GetFullList.AddRange(data(i))
  1818. Else
  1819. GetFullList.Add(data(i))
  1820. End If
  1821. Next i
  1822. End Function
  1823. ''' <summary>
  1824. ''' 数组去重。
  1825. ''' </summary>
  1826. <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As CompareThreadStart(Of T)) As List(Of T)
  1827. Dim ResultArray As New List(Of T)
  1828. For i = 0 To Arr.Count - 1
  1829. For ii = i + 1 To Arr.Count - 1
  1830. If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement
  1831. Next
  1832. ResultArray.Add(Arr(i))
  1833. NextElement:
  1834. Next i
  1835. Return ResultArray
  1836. End Function
  1837. ''' <summary>
  1838. ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
  1839. ''' </summary>
  1840. Public Function GetTimeNow() As String
  1841. Return Date.Now.ToString("HH':'mm':'ss'.'fff")
  1842. End Function
  1843. ''' <summary>
  1844. ''' 获取系统运行时间(毫秒),保证为正 Long 且大于 1,但可能突变减小。
  1845. ''' </summary>
  1846. Public Function GetTimeTick() As Long
  1847. Return My.Computer.Clock.TickCount + 2147483651L
  1848. End Function
  1849. ''' <summary>
  1850. ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
  1851. ''' </summary>
  1852. Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
  1853. Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
  1854. If Span.TotalMilliseconds < 0 Then Span = -Span
  1855. Dim TotalMonthes = Math.Floor(Span.Days / 30)
  1856. If IsShortForm Then
  1857. If TotalMonthes >= 12 Then
  1858. '1+ 年,“3 年”
  1859. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  1860. ElseIf TotalMonthes >= 2 Then
  1861. '2~11 月,“5 个月”
  1862. GetTimeSpanString = TotalMonthes & " 个月"
  1863. ElseIf Span.TotalDays >= 2 Then
  1864. '2 天 ~ 2 月,“23 天”
  1865. GetTimeSpanString = Span.Days & " 天"
  1866. ElseIf Span.TotalHours >= 1 Then
  1867. '1 小时 ~ 2 天,“15 小时”
  1868. GetTimeSpanString = Span.Hours & " 小时"
  1869. ElseIf Span.TotalMinutes >= 1 Then
  1870. '1 分钟 ~ 1 小时,“49 分钟”
  1871. GetTimeSpanString = Span.Minutes & " 分钟"
  1872. ElseIf Span.TotalSeconds >= 1 Then
  1873. '1 秒 ~ 1 分钟,“23 秒”
  1874. GetTimeSpanString = Span.Seconds & " 秒"
  1875. Else
  1876. '不到 1 秒
  1877. GetTimeSpanString = "1 秒"
  1878. End If
  1879. Else
  1880. If TotalMonthes >= 61 Then
  1881. '5+ 年,“5 年”
  1882. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  1883. ElseIf TotalMonthes >= 12 Then
  1884. '12~60 月,“1 年 2 个月”
  1885. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
  1886. ElseIf TotalMonthes >= 4 Then
  1887. '4~11 月,“5 月”
  1888. GetTimeSpanString = TotalMonthes & " 月"
  1889. ElseIf TotalMonthes >= 1 Then
  1890. '1~4 月,“2 月 13 天”
  1891. GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
  1892. ElseIf Span.TotalDays >= 4 Then
  1893. '4~30 天,“23 天”
  1894. GetTimeSpanString = Span.Days & " 天"
  1895. ElseIf Span.TotalDays >= 1 Then
  1896. '1~3 天,“2 天 20 小时”
  1897. GetTimeSpanString = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
  1898. ElseIf Span.TotalHours >= 10 Then
  1899. '10 小时 ~ 1 天,“15 小时”
  1900. GetTimeSpanString = Span.Hours & " 小时"
  1901. ElseIf Span.TotalHours >= 1 Then
  1902. '1~10 小时,“1 小时 20 分钟”
  1903. GetTimeSpanString = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
  1904. ElseIf Span.TotalMinutes >= 10 Then
  1905. '10 分钟 ~ 1 小时,“49 分钟”
  1906. GetTimeSpanString = Span.Minutes & " 分钟"
  1907. ElseIf Span.TotalMinutes >= 1 Then
  1908. '1~10 分钟,“9 分 23 秒”
  1909. GetTimeSpanString = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
  1910. ElseIf Span.TotalSeconds >= 1 Then
  1911. '1 秒 ~ 1 分钟,“23 秒”
  1912. GetTimeSpanString = Span.Seconds & " 秒"
  1913. Else
  1914. '不到 1 秒
  1915. GetTimeSpanString = "1 秒"
  1916. End If
  1917. End If
  1918. GetTimeSpanString += EndFix
  1919. End Function
  1920. ''' <summary>
  1921. ''' 获取十进制 Unix 时间戳。
  1922. ''' </summary>
  1923. Public Function GetUnixTimestamp() As Long
  1924. Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000
  1925. End Function
  1926. ''' <summary>
  1927. ''' 用于储存 RaiseByMouse 的 EventArgs。
  1928. ''' </summary>
  1929. Public NotInheritable Class RouteEventArgs
  1930. Inherits EventArgs
  1931. Public RaiseByMouse As Boolean
  1932. Public Handled As Boolean = False
  1933. Public Sub New(Optional RaiseByMouse As Boolean = False)
  1934. Me.RaiseByMouse = RaiseByMouse
  1935. End Sub
  1936. End Class
  1937. ''' <summary>
  1938. ''' 前台运行文件。
  1939. ''' </summary>
  1940. ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
  1941. ''' <param name="Arguments">运行参数。</param>
  1942. Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
  1943. Using Program As New Process
  1944. Program.StartInfo.Arguments = Arguments
  1945. Program.StartInfo.FileName = FileName
  1946. Log("[System] 执行外部命令:" & FileName & " " & Arguments)
  1947. Program.Start()
  1948. End Using
  1949. End Sub
  1950. ''' <summary>
  1951. ''' 前台运行文件并返回返回值。
  1952. ''' </summary>
  1953. ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
  1954. ''' <param name="Arguments">运行参数。</param>
  1955. ''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会返回 Result.Timeout。</param>
  1956. Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As Result
  1957. Try
  1958. Using Program As New Process
  1959. Program.StartInfo.Arguments = Arguments
  1960. Program.StartInfo.FileName = FileName
  1961. Log("[System] 执行外部命令并等待返回码:" & FileName & " " & Arguments)
  1962. Program.Start()
  1963. If Program.WaitForExit(Timeout) Then
  1964. Return Program.ExitCode
  1965. Else
  1966. Return Result.Timeout
  1967. End If
  1968. End Using
  1969. Catch ex As Exception
  1970. Log(ex, "执行命令失败:" & FileName, LogLevel.Msgbox)
  1971. Return Result.Fail
  1972. End Try
  1973. End Function
  1974. ''' <summary>
  1975. ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
  1976. ''' </summary>
  1977. ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
  1978. ''' <param name="Arguments">运行参数。</param>
  1979. ''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
  1980. Public Function ShellAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000, Optional WorkingDirectory As String = Nothing) As String
  1981. Dim Info = New ProcessStartInfo With {
  1982. .Arguments = Arguments,
  1983. .FileName = FileName,
  1984. .UseShellExecute = False,
  1985. .CreateNoWindow = True,
  1986. .RedirectStandardError = True,
  1987. .RedirectStandardOutput = True,
  1988. .WorkingDirectory = If(WorkingDirectory, Path.TrimEnd("\"c))
  1989. }
  1990. If WorkingDirectory IsNot Nothing Then
  1991. If Info.EnvironmentVariables.ContainsKey("appdata") Then
  1992. Info.EnvironmentVariables("appdata") = WorkingDirectory
  1993. Else
  1994. Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
  1995. End If
  1996. End If
  1997. Log("[System] 执行外部命令并等待返回结果:" & FileName & " " & Arguments)
  1998. Using Program As New Process() With {.StartInfo = Info}
  1999. Program.Start()
  2000. Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
  2001. Program.WaitForExit(Timeout)
  2002. If Not Program.HasExited Then Program.Kill()
  2003. Return Result
  2004. End Using
  2005. End Function
  2006. ''' <summary>
  2007. ''' 在新的工作线程中执行代码。
  2008. ''' </summary>
  2009. Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
  2010. Dim th As New Thread(
  2011. Sub()
  2012. Try
  2013. Action()
  2014. Catch ex As ThreadInterruptedException
  2015. Log(Name & ":线程已中止")
  2016. Catch ex As Exception
  2017. Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
  2018. End Try
  2019. End Sub) With {.Name = Name, .Priority = Priority}
  2020. th.Start()
  2021. Return th
  2022. End Function
  2023. ''' <summary>
  2024. ''' 确保在 UI 线程中执行代码。
  2025. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  2026. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  2027. ''' </summary>
  2028. Public Function RunInUiWait(Of Output)(Action As Func(Of Output)) As Output
  2029. If RunInUi() Then
  2030. Return Action()
  2031. Else
  2032. Return Application.Current.Dispatcher.Invoke(Action)
  2033. End If
  2034. End Function
  2035. ''' <summary>
  2036. ''' 确保在 UI 线程中执行代码。
  2037. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  2038. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  2039. ''' </summary>
  2040. Public Sub RunInUiWait(Action As Action)
  2041. If RunInUi() Then
  2042. Action()
  2043. Else
  2044. Application.Current.Dispatcher.Invoke(Action)
  2045. End If
  2046. End Sub
  2047. ''' <summary>
  2048. ''' 确保在 UI 线程中执行代码,代码按触发顺序执行。
  2049. ''' 如果当前并非 UI 线程,也不阻断当前线程的执行。
  2050. ''' </summary>
  2051. Public Sub RunInUi(Action As Action, Optional ForceWaitUntilLoaded As Boolean = False)
  2052. If ForceWaitUntilLoaded Then
  2053. Application.Current.Dispatcher.InvokeAsync(Action, Threading.DispatcherPriority.Loaded)
  2054. ElseIf RunInUi() Then
  2055. Action()
  2056. Else
  2057. Application.Current.Dispatcher.InvokeAsync(Action)
  2058. End If
  2059. End Sub
  2060. ''' <summary>
  2061. ''' 确保在工作线程中执行代码。
  2062. ''' </summary>
  2063. Public Sub RunInThread(Action As Action)
  2064. If RunInUi() Then
  2065. RunInNewThread(Action, "Runtime Invoke " & GetUuid() & "#")
  2066. Else
  2067. Action()
  2068. End If
  2069. End Sub
  2070. ''' <summary>
  2071. ''' 按照既定的函数进行选择排序。
  2072. ''' </summary>
  2073. ''' <param name="SortRule">传入两个对象,若第一个对象应该排在前面,则返回 True。</param>
  2074. <Extension> Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
  2075. Dim NewList As New List(Of T)
  2076. While List.Any
  2077. Dim Highest = List(0)
  2078. For i = 1 To List.Count - 1
  2079. If SortRule(List(i), Highest) Then Highest = List(i)
  2080. Next
  2081. List.Remove(Highest)
  2082. NewList.Add(Highest)
  2083. End While
  2084. Return NewList
  2085. End Function
  2086. Public Delegate Function CompareThreadStart(Of T)(Left As T, Right As T) As Boolean
  2087. ''' <summary>
  2088. ''' 返回列表的浅表副本。
  2089. ''' </summary>
  2090. <Extension> Public Function Clone(Of T)(list As IList(Of T)) As IList(Of T)
  2091. Return New List(Of T)(list)
  2092. End Function
  2093. ''' <summary>
  2094. ''' 获取程序启动参数。
  2095. ''' </summary>
  2096. ''' <param name="Name">参数名。</param>
  2097. ''' <param name="DefaultValue">默认值。</param>
  2098. Public Function GetProgramArgument(Name As String, Optional DefaultValue As Object = "")
  2099. Dim AllArguments() As String = Command.Split(" ")
  2100. For i = 0 To AllArguments.Length - 1
  2101. If AllArguments(i) = "-" & Name Then
  2102. If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
  2103. Return AllArguments(i + 1)
  2104. End If
  2105. Next
  2106. Return DefaultValue
  2107. End Function
  2108. ''' <summary>
  2109. ''' 时间戳转化为日期。
  2110. ''' </summary>
  2111. Public Function GetDate(timeStamp As Integer) As Date
  2112. Dim dtStart As Date = TimeZone.CurrentTimeZone.ToLocalTime(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc))
  2113. Dim lTime As Long = (CLng(timeStamp) * 10000000)
  2114. Return dtStart.Add(New TimeSpan(lTime))
  2115. End Function
  2116. ''' <summary>
  2117. ''' 将 UTC 时间转化为当前时区的时间。
  2118. ''' </summary>
  2119. Public Function GetLocalTime(UtcDate As Date) As Date
  2120. Return DateTime.SpecifyKind(UtcDate, DateTimeKind.Utc).ToLocalTime
  2121. End Function
  2122. ''' <summary>
  2123. ''' 打开网页。
  2124. ''' </summary>
  2125. Public Sub OpenWebsite(Url As String)
  2126. Try
  2127. If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
  2128. Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
  2129. End If
  2130. Log("[System] 正在打开网页:" & Url)
  2131. Process.Start(Url)
  2132. Catch ex As Exception
  2133. Log(ex, "无法打开网页(" & Url & ")")
  2134. ClipboardSet(Url, False)
  2135. MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf &
  2136. $"网址:{Url}", "无法打开网页")
  2137. End Try
  2138. End Sub
  2139. ''' <summary>
  2140. ''' 打开 explorer。注意参数中的路径要尽量加上双引号!
  2141. ''' </summary>
  2142. Public Sub OpenExplorer(Argument As String)
  2143. Try
  2144. ShellOnly("explorer.exe", Argument)
  2145. Catch ex As Exception
  2146. Log(ex, "打开资源管理器失败,请尝试关闭安全软件(如 360 安全卫士)", LogLevel.Msgbox)
  2147. End Try
  2148. End Sub
  2149. ''' <summary>
  2150. ''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
  2151. ''' </summary>
  2152. Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
  2153. RunInThread(
  2154. Sub()
  2155. Dim RetryCount As Integer = 0
  2156. Retry:
  2157. Try
  2158. RunInUi(
  2159. Sub()
  2160. My.Computer.Clipboard.Clear()
  2161. My.Computer.Clipboard.SetText(Text)
  2162. End Sub)
  2163. Catch ex As Exception
  2164. RetryCount += 1
  2165. If RetryCount <= 5 Then
  2166. Thread.Sleep(20)
  2167. GoTo Retry
  2168. Else
  2169. Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
  2170. End If
  2171. End Try
  2172. If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
  2173. End Sub)
  2174. End Sub
  2175. ''' <summary>
  2176. ''' 以 Byte() 形式获取程序中的资源。
  2177. ''' </summary>
  2178. Public Function GetResources(ResourceName As String) As Byte()
  2179. Log("[System] 获取资源:" & ResourceName)
  2180. Dim Raw As Byte() = My.Resources.ResourceManager.GetObject(ResourceName)
  2181. Return Raw
  2182. End Function
  2183. #End Region
  2184. #Region "UI"
  2185. '边距改变
  2186. ''' <summary>
  2187. ''' 相对增减控件的左边距。
  2188. ''' </summary>
  2189. Public Sub DeltaLeft(control As FrameworkElement, newValue As Double)
  2190. '安全性检查
  2191. DebugAssert(Not Double.IsNaN(newValue))
  2192. DebugAssert(Not Double.IsInfinity(newValue))
  2193. If TypeOf control Is Window Then
  2194. '窗口改变
  2195. CType(control, Window).Left += newValue
  2196. Else
  2197. '根据 HorizontalAlignment 改变数值
  2198. Select Case control.HorizontalAlignment
  2199. Case HorizontalAlignment.Left, HorizontalAlignment.Stretch
  2200. control.Margin = New Thickness(control.Margin.Left + newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom)
  2201. Case HorizontalAlignment.Right
  2202. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right - newValue, control.Margin.Bottom)
  2203. 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom)
  2204. Case Else
  2205. DebugAssert(False)
  2206. End Select
  2207. End If
  2208. End Sub
  2209. ''' <summary>
  2210. ''' 设置控件的左边距。(仅针对置左控件)
  2211. ''' </summary>
  2212. Public Sub SetLeft(control As FrameworkElement, newValue As Double)
  2213. DebugAssert(control.HorizontalAlignment = HorizontalAlignment.Left)
  2214. control.Margin = New Thickness(newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom)
  2215. End Sub
  2216. ''' <summary>
  2217. ''' 相对增减控件的上边距。
  2218. ''' </summary>
  2219. Public Sub DeltaTop(control As FrameworkElement, newValue As Double)
  2220. '安全性检查
  2221. DebugAssert(Not Double.IsNaN(newValue))
  2222. DebugAssert(Not Double.IsInfinity(newValue))
  2223. If TypeOf control Is Window Then
  2224. '窗口改变
  2225. CType(control, Window).Top += newValue
  2226. Else
  2227. '根据 VerticalAlignment 改变数值
  2228. Select Case control.VerticalAlignment
  2229. Case VerticalAlignment.Top
  2230. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top + newValue, control.Margin.Right, control.Margin.Bottom)
  2231. Case VerticalAlignment.Bottom
  2232. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, control.Margin.Bottom - newValue)
  2233. 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom)
  2234. Case Else
  2235. DebugAssert(False)
  2236. End Select
  2237. End If
  2238. 'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Exit Sub '安全性检查
  2239. 'Select Case control.VerticalAlignment
  2240. ' Case VerticalAlignment.Top, VerticalAlignment.Stretch, VerticalAlignment.Center
  2241. ' control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom)
  2242. ' Case VerticalAlignment.Bottom
  2243. ' control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, -newValue)
  2244. ' 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, CType(control.Parent, Object).ActualHeight - control.ActualHeight - newValue)
  2245. 'End Select
  2246. End Sub
  2247. ''' <summary>
  2248. ''' 设置控件的顶边距。(仅针对置上控件)
  2249. ''' </summary>
  2250. Public Sub SetTop(control As FrameworkElement, newValue As Double)
  2251. DebugAssert(control.VerticalAlignment = VerticalAlignment.Top)
  2252. control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom)
  2253. End Sub
  2254. 'DPI 转换
  2255. Public ReadOnly DPI As Integer = System.Drawing.Graphics.FromHwnd(IntPtr.Zero).DpiX
  2256. ''' <summary>
  2257. ''' 将经过 DPI 缩放的 WPF 尺寸转化为实际的像素尺寸。
  2258. ''' </summary>
  2259. Public Function GetPixelSize(WPFSize As Double) As Double
  2260. Return WPFSize / 96 * DPI
  2261. End Function
  2262. ''' <summary>
  2263. ''' 将实际的像素尺寸转化为经过 DPI 缩放的 WPF 尺寸。
  2264. ''' </summary>
  2265. Public Function GetWPFSize(PixelSize As Double) As Double
  2266. Return PixelSize * 96 / DPI
  2267. End Function
  2268. 'UI 截图
  2269. ''' <summary>
  2270. ''' 将某个控件的呈现转换为图片。
  2271. ''' </summary>
  2272. Public Function ControlBrush(UI As FrameworkElement) As ImageBrush
  2273. Dim Width = UI.ActualWidth, Height = UI.ActualHeight
  2274. If Width < 1 OrElse Height < 1 Then Return New ImageBrush
  2275. Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Pbgra32)
  2276. bmp.Render(UI)
  2277. Return New ImageBrush(bmp)
  2278. End Function
  2279. ''' <summary>
  2280. ''' 将某个控件的模拟呈现转换为图片。
  2281. ''' </summary>
  2282. Public Function ControlBrush(UI As FrameworkElement, Width As Double, Height As Double, Optional Left As Double = 0, Optional Top As Double = 0) As ImageBrush
  2283. UI.Measure(New Size(Width, Height))
  2284. UI.Arrange(New Rect(0, 0, Width, Height))
  2285. Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Default)
  2286. bmp.Render(UI)
  2287. If Not (Left = 0 AndAlso Top = 0) Then UI.Arrange(New Rect(Left, Top, Width, Height))
  2288. Return New ImageBrush(bmp)
  2289. End Function
  2290. ''' <summary>
  2291. ''' 将 UI 内容固定为图片并进行 Clear。
  2292. ''' </summary>
  2293. Public Sub ControlFreeze(UI As Panel)
  2294. UI.Background = ControlBrush(UI)
  2295. UI.Children.Clear()
  2296. End Sub
  2297. ''' <summary>
  2298. ''' 将 UI 内容固定为图片并进行 Clear。
  2299. ''' </summary>
  2300. Public Sub ControlFreeze(UI As Border)
  2301. UI.Background = ControlBrush(UI)
  2302. UI.Child = Nothing
  2303. End Sub
  2304. ''' <summary>
  2305. ''' 将 XML 转换为对应 UI 对象。
  2306. ''' </summary>
  2307. Public Function GetObjectFromXML(Str As XElement)
  2308. Return GetObjectFromXML(Str.ToString)
  2309. End Function
  2310. ''' <summary>
  2311. ''' 将 XML 转换为对应 UI 对象。
  2312. ''' </summary>
  2313. Public Function GetObjectFromXML(Str As String)
  2314. Using Stream As New MemoryStream
  2315. Using Writer As New StreamWriter(Stream)
  2316. Writer.Write(Str)
  2317. Writer.Flush()
  2318. Stream.Position = 0
  2319. Return XamlReader.Load(Stream)
  2320. End Using
  2321. End Using
  2322. End Function
  2323. Private ReadOnly UiThreadId As Integer = Thread.CurrentThread.ManagedThreadId
  2324. ''' <summary>
  2325. ''' 当前线程是否为主线程。
  2326. ''' </summary>
  2327. Public Function RunInUi() As Boolean
  2328. Return Thread.CurrentThread.ManagedThreadId = UiThreadId
  2329. End Function
  2330. ''' <summary>
  2331. ''' 检查某个控件是否位于主窗口可视区域内,且控件本身可见。
  2332. ''' </summary>
  2333. <Extension> Public Function IsVisibleInForm(element As FrameworkElement) As Boolean
  2334. If Not element.IsVisible Then Return False
  2335. Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight))
  2336. Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight)
  2337. Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
  2338. End Function
  2339. #End Region
  2340. #Region "Debug"
  2341. Public ModeDebug As Boolean = False
  2342. 'Log
  2343. Public Enum LogLevel
  2344. ''' <summary>
  2345. ''' 不提示,只记录日志。
  2346. ''' </summary>
  2347. Normal = 0
  2348. ''' <summary>
  2349. ''' 只提示开发者。
  2350. ''' </summary>
  2351. Developer = 1
  2352. ''' <summary>
  2353. ''' 只提示开发者与调试模式用户。
  2354. ''' </summary>
  2355. Debug = 2
  2356. ''' <summary>
  2357. ''' 弹出提示所有用户。
  2358. ''' </summary>
  2359. Hint = 3
  2360. ''' <summary>
  2361. ''' 弹窗,不要求反馈。
  2362. ''' </summary>
  2363. Msgbox = 4
  2364. ''' <summary>
  2365. ''' 弹窗,要求反馈。
  2366. ''' </summary>
  2367. Feedback = 5
  2368. ''' <summary>
  2369. ''' 弹窗,结束程序。
  2370. ''' </summary>
  2371. Assert = 6
  2372. End Enum
  2373. Private LogList As New StringBuilder
  2374. Private LogWritter As StreamWriter
  2375. Public Sub LogStart()
  2376. RunInNewThread(
  2377. Sub()
  2378. Dim IsInitSuccess As Boolean = True
  2379. Try
  2380. For i = 4 To 1 Step -1
  2381. If File.Exists(Path & "PCL\Log" & i & ".txt") Then
  2382. If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
  2383. CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
  2384. End If
  2385. Next
  2386. File.Create(Path & "PCL\Log1.txt").Dispose()
  2387. Catch ex As IOException
  2388. IsInitSuccess = False
  2389. Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
  2390. Log(ex, "日志初始化失败(疑似文件占用问题)")
  2391. Catch ex As Exception
  2392. IsInitSuccess = False
  2393. Log(ex, "日志初始化失败", LogLevel.Hint)
  2394. End Try
  2395. Try
  2396. LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
  2397. Catch ex As Exception
  2398. LogWritter = Nothing
  2399. Log(ex, "日志写入失败", LogLevel.Hint)
  2400. End Try
  2401. While True
  2402. If IsInitSuccess Then
  2403. LogFlush()
  2404. Else
  2405. LogList = New StringBuilder '清空 LogList 避免内存爆炸
  2406. End If
  2407. Thread.Sleep(50)
  2408. End While
  2409. End Sub, "Log Writer", ThreadPriority.Lowest)
  2410. End Sub
  2411. Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
  2412. Public Sub LogFlush()
  2413. On Error Resume Next
  2414. If LogWritter Is Nothing Then Exit Sub
  2415. Dim Log As String = Nothing
  2416. SyncLock LogFlushLock
  2417. If LogList.Length > 0 Then
  2418. Dim LogListCache As StringBuilder
  2419. LogListCache = LogList
  2420. LogList = New StringBuilder
  2421. Log = LogListCache.ToString
  2422. End If
  2423. End SyncLock
  2424. If Log IsNot Nothing Then
  2425. LogWritter.Write(Log)
  2426. End If
  2427. End Sub
  2428. Private ReadOnly LogListLock As New Object '防止日志乱码,只在调试模式下启用
  2429. ''' <summary>
  2430. ''' 输出 Log。
  2431. ''' </summary>
  2432. ''' <param name="Title">如果要求弹窗,指定弹窗的标题。</param>
  2433. Public Sub Log(Text As String, Optional Level As LogLevel = LogLevel.Normal, Optional Title As String = "出现错误")
  2434. On Error Resume Next
  2435. '放在最后会导致无法显示极端错误下的弹窗(如无法写入日志文件)
  2436. '处理错误会导致再次调用 Log() 导致无限循环
  2437. '输出日志
  2438. Dim AppendText As String = "[" & GetTimeNow() & "] " & Text & vbCrLf '减轻同步锁占用
  2439. If ModeDebug Then
  2440. SyncLock LogListLock
  2441. LogList.Append(AppendText)
  2442. End SyncLock
  2443. Else
  2444. LogList.Append(AppendText)
  2445. End If
  2446. #If DEBUG Then
  2447. Console.Write(AppendText)
  2448. #End If
  2449. If IsProgramEnded OrElse Level = LogLevel.Normal Then Exit Sub
  2450. '去除前缀
  2451. Text = RegexReplace(Text, "", "\[[^\]]+?\] ")
  2452. '输出提示
  2453. Select Case Level
  2454. #If DEBUG Then
  2455. Case LogLevel.Developer
  2456. Hint("[开发者模式] " & Text, HintType.Info, False)
  2457. Case LogLevel.Debug
  2458. Hint("[调试模式] " & Text, HintType.Info, False)
  2459. #Else
  2460. Case LogLevel.Developer
  2461. Case LogLevel.Debug
  2462. If ModeDebug Then Hint("[调试模式] " & Text, HintType.Info, False)
  2463. #End If
  2464. Case LogLevel.Hint
  2465. Hint(Text, HintType.Critical, False)
  2466. Case LogLevel.Msgbox
  2467. MyMsgBox(Text, Title, IsWarn:=True)
  2468. Case LogLevel.Feedback
  2469. If CanFeedback(False) Then
  2470. If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  2471. Else
  2472. MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  2473. End If
  2474. Case LogLevel.Assert
  2475. Dim Time As Long = GetTimeTick()
  2476. If CanFeedback(False) Then
  2477. If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  2478. Else
  2479. MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  2480. End If
  2481. If GetTimeTick() - Time < 1500 Then
  2482. '弹窗无法保留
  2483. Log("[System] PCL 已崩溃:" & vbCrLf & Text)
  2484. FormMain.EndProgramForce(Result.Exception)
  2485. Else
  2486. FormMain.EndProgramForce(Result.Fail)
  2487. End If
  2488. End Select
  2489. End Sub
  2490. ''' <summary>
  2491. ''' 输出错误信息。
  2492. ''' </summary>
  2493. ''' <param name="Desc">错误描述。会在处理时在末尾加入冒号。</param>
  2494. Public Sub Log(Ex As Exception, Desc As String, Optional Level As LogLevel = LogLevel.Debug, Optional Title As String = "出现错误")
  2495. On Error Resume Next
  2496. If TypeOf Ex Is ThreadInterruptedException Then Exit Sub
  2497. '获取错误信息
  2498. Dim ExFull As String = Desc & ":" & GetExceptionDetail(Ex)
  2499. '输出日志
  2500. Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & ":" & GetExceptionDetail(Ex, True) & vbCrLf '减轻同步锁占用
  2501. If ModeDebug Then
  2502. SyncLock LogListLock
  2503. LogList.Append(AppendText)
  2504. End SyncLock
  2505. Else
  2506. LogList.Append(AppendText)
  2507. End If
  2508. #If DEBUG Then
  2509. Console.Write(AppendText)
  2510. #End If
  2511. If IsProgramEnded Then Exit Sub
  2512. '输出提示
  2513. Select Case Level
  2514. Case LogLevel.Normal
  2515. #If DEBUG Then
  2516. Case LogLevel.Developer
  2517. Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
  2518. Hint("[开发者模式] " & ExLine, HintType.Info, False)
  2519. Case LogLevel.Debug
  2520. Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
  2521. Hint("[调试模式] " & ExLine, HintType.Info, False)
  2522. #Else
  2523. Case LogLevel.Developer
  2524. Case LogLevel.Debug
  2525. Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
  2526. If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
  2527. #End If
  2528. Case LogLevel.Hint
  2529. Dim ExLine As String = Desc & ":" & GetExceptionSummary(Ex)
  2530. Hint(ExLine, HintType.Critical, False)
  2531. Case LogLevel.Msgbox
  2532. MyMsgBox(ExFull, Title, IsWarn:=True)
  2533. Case LogLevel.Feedback
  2534. If CanFeedback(False) Then
  2535. If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  2536. Else
  2537. MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  2538. End If
  2539. Case LogLevel.Assert
  2540. Dim Time As Long = GetTimeTick()
  2541. If CanFeedback(False) Then
  2542. If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  2543. Else
  2544. MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  2545. End If
  2546. If GetTimeTick() - Time < 1500 Then
  2547. '弹窗无法保留
  2548. Log("[System] PCL 已崩溃:" & vbCrLf & ExFull)
  2549. FormMain.EndProgramForce(Result.Exception)
  2550. Else
  2551. FormMain.EndProgramForce(Result.Fail)
  2552. End If
  2553. End Select
  2554. End Sub
  2555. '反馈
  2556. Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
  2557. On Error Resume Next
  2558. FeedbackInfo()
  2559. If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
  2560. OpenExplorer("""" & Path & "PCL\""")
  2561. End If
  2562. OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
  2563. End Sub
  2564. Public Function CanFeedback(ShowHint As Boolean) As Boolean
  2565. If False.Equals(PageSetupSystem.IsLauncherNewest) Then
  2566. If ShowHint Then
  2567. If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
  2568. UpdateCheckByButton()
  2569. End If
  2570. End If
  2571. Return False
  2572. Else
  2573. Return True
  2574. End If
  2575. End Function
  2576. ''' <summary>
  2577. ''' 在日志中输出系统诊断信息。
  2578. ''' </summary>
  2579. Public Sub FeedbackInfo()
  2580. On Error Resume Next
  2581. Log("[System] 诊断信息:" & vbCrLf &
  2582. "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
  2583. "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
  2584. "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
  2585. "MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
  2586. "文件位置:" & Path)
  2587. End Sub
  2588. '断言
  2589. Public Sub DebugAssert(Exp As Boolean)
  2590. If Not Exp Then Throw New Exception("断言命中")
  2591. End Sub
  2592. '获取当前的堆栈信息
  2593. Public Function GetStackTrace() As String
  2594. Dim Stack As New StackTrace()
  2595. Return Join(Stack.GetFrames().Skip(1).Select(Function(f) f.GetMethod).
  2596. Select(Function(f) f.Name & "(" & Join(f.GetParameters.Select(Function(p) p.ToString).ToList, ", ") & ") - " & f.Module.ToString).ToList,
  2597. vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf)
  2598. End Function
  2599. #End Region
  2600. #Region "随机"
  2601. Private ReadOnly Random As New Random
  2602. ''' <summary>
  2603. ''' 随机选择其一。
  2604. ''' </summary>
  2605. Public Function RandomOne(Of T)(objects As ICollection(Of T)) As T
  2606. Return objects(RandomInteger(0, objects.Count - 1))
  2607. End Function
  2608. ''' <summary>
  2609. ''' 取随机整数。
  2610. ''' </summary>
  2611. Public Function RandomInteger(min As Integer, max As Integer) As Integer
  2612. Return Math.Floor((max - min + 1) * Random.NextDouble) + min
  2613. End Function
  2614. ''' <summary>
  2615. ''' 将数组随机打乱。
  2616. ''' </summary>
  2617. Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
  2618. Shuffle = New List(Of T)
  2619. Do While array.Any
  2620. Dim i As Integer = RandomInteger(0, array.Count - 1)
  2621. Shuffle.Add(array(i))
  2622. array.RemoveAt(i)
  2623. Loop
  2624. End Function
  2625. #End Region
  2626. End Module