ModBase.vb 130 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612
  1. Imports System.Globalization
  2. Imports System.Net.Sockets
  3. Imports System.Runtime.CompilerServices
  4. Imports System.Security.Cryptography
  5. Imports System.Security.Principal
  6. Imports System.Text.RegularExpressions
  7. Imports System.Threading.Tasks
  8. Imports System.Xaml
  9. Imports Newtonsoft.Json
  10. Public Module ModBase
  11. #Region "声明"
  12. '下列版本信息由更新器自动修改
  13. Public Const VersionBaseName As String = "2.12.7.1" '显示用版本名
  14. Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
  15. #If RELEASE Then
  16. Public Const VersionCode As Integer = 394 '正式版
  17. #Else
  18. Public Const VersionCode As Integer = 393 '快照版
  19. #End If
  20. '版本信息
  21. Public Const VersionDisplay As String = BuildTypeDisplay & " " & VersionBaseName
  22. #If DEBUG Then
  23. Public Const BuildTypeDisplay As String = "开发版"
  24. Public Const BuildType As BuildTypes = BuildTypes.Debug
  25. #ElseIf RELEASE Then
  26. Public Const BuildTypeDisplay As String = "正式版"
  27. Public Const BuildType As BuildTypes = BuildTypes.Release
  28. #Else
  29. Public Const BuildTypeDisplay As String = "快照版"
  30. Public Const BuildType As BuildTypes = BuildTypes.Snapshot
  31. #End If
  32. Public Enum BuildTypes
  33. Debug = 100
  34. Release = 50
  35. Snapshot = 0
  36. End Enum
  37. ''' <summary>
  38. ''' 主窗口句柄。
  39. ''' </summary>
  40. Public Handle As IntPtr
  41. ''' <summary>
  42. ''' 程序的启动路径,以 \ 结尾。
  43. ''' </summary>
  44. Public PathExeFolder As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
  45. ''' <summary>
  46. ''' 包含程序名的完整路径。
  47. ''' </summary>
  48. Public PathExe As String = PathExeFolder & AppDomain.CurrentDomain.SetupInformation.ApplicationName
  49. ''' <summary>
  50. ''' 程序内嵌图片文件夹路径,以 / 结尾。
  51. ''' </summary>
  52. Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
  53. ''' <summary>
  54. ''' 程序的缓存文件夹路径,以 \ 结尾。
  55. ''' </summary>
  56. Public PathTemp As String = If(Settings.Get("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
  57. ''' <summary>
  58. ''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
  59. ''' </summary>
  60. Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
  61. ''' <summary>
  62. ''' 当前程序的语言。
  63. ''' </summary>
  64. Public Lang As String = "zh_CN"
  65. ''' <summary>
  66. ''' 程序的打开计时。
  67. ''' </summary>
  68. Public ApplicationStartTick As Long = GetTimeMs()
  69. ''' <summary>
  70. ''' 程序打开时的时间。
  71. ''' </summary>
  72. Public ApplicationOpenTime As Date = Date.Now
  73. ''' <summary>
  74. ''' 识别码。
  75. ''' </summary>
  76. Public Identify As String = GetIdentify()
  77. ''' <summary>
  78. ''' 程序是否已结束。
  79. ''' </summary>
  80. Public IsProgramEnded As Boolean = False
  81. ''' <summary>
  82. ''' 是否为 32 位系统。
  83. ''' </summary>
  84. Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
  85. ''' <summary>
  86. ''' 是否使用 GBK 编码。
  87. ''' </summary>
  88. Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
  89. ''' <summary>
  90. ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
  91. ''' </summary>
  92. Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.Upper.First & ":\" '#3799
  93. #End Region
  94. #Region "矢量图标"
  95. Public Class Logo
  96. ''' <summary>
  97. ''' 图标按钮,心(空心),1.1x
  98. ''' </summary>
  99. 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"
  100. ''' <summary>
  101. ''' 图标按钮,心(实心),1.1x
  102. ''' </summary>
  103. 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"
  104. ''' <summary>
  105. ''' 图标按钮,垃圾桶,1.1x
  106. ''' </summary>
  107. 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"
  108. ''' <summary>
  109. ''' 图标按钮,禁止,1x
  110. ''' </summary>
  111. 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"
  112. ''' <summary>
  113. ''' 图标按钮,勾选,1x
  114. ''' </summary>
  115. 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"
  116. ''' <summary>
  117. ''' 图标按钮,笔,1x
  118. ''' </summary>
  119. 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"
  120. ''' <summary>
  121. ''' 图标按钮,齿轮,1.1x
  122. ''' </summary>
  123. 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"
  124. ''' <summary>
  125. ''' 图标按钮,重置,0.9x
  126. ''' </summary>
  127. 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"
  128. ''' <summary>
  129. ''' 图标按钮,刷新,0.85x
  130. ''' </summary>
  131. 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"
  132. ''' <summary>
  133. ''' 图标按钮,软盘,1x
  134. ''' </summary>
  135. 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"
  136. ''' <summary>
  137. ''' 图标按钮,信息,1.05x
  138. ''' </summary>
  139. 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"
  140. ''' <summary>
  141. ''' 图标按钮,列表,1x
  142. ''' </summary>
  143. 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"
  144. ''' <summary>
  145. ''' 图标按钮,文件夹,1.15x
  146. ''' </summary>
  147. 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"
  148. ''' <summary>
  149. ''' 图标按钮,名片,1.1x
  150. ''' </summary>
  151. 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"
  152. ''' <summary>
  153. ''' 图标按钮,×,0.85x
  154. ''' </summary>
  155. 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"
  156. ''' <summary>
  157. ''' 图标按钮,Mojang,1.1x
  158. ''' </summary>
  159. 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"
  160. ''' <summary>
  161. ''' 图标按钮,用户,0.95x
  162. ''' </summary>
  163. 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"
  164. ''' <summary>
  165. ''' 图标按钮,盾牌,1x
  166. ''' </summary>
  167. 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"
  168. ''' <summary>
  169. ''' 图标按钮,离线,0.85x
  170. ''' </summary>
  171. 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"
  172. ''' <summary>
  173. ''' 图标,服务端,1x
  174. ''' </summary>
  175. Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
  176. ''' <summary>
  177. ''' 图标,音符,1x
  178. ''' </summary>
  179. 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"
  180. ''' <summary>
  181. ''' 图标,播放,0.8x
  182. ''' </summary>
  183. 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"
  184. End Class
  185. #End Region
  186. #Region "自定义类"
  187. ''' <summary>
  188. ''' 支持小数与常见类型隐式转换的颜色。
  189. ''' </summary>
  190. Public Class MyColor
  191. Public A As Double = 255
  192. Public R As Double = 0
  193. Public G As Double = 0
  194. Public B As Double = 0
  195. '类型转换
  196. Public Shared Widening Operator CType(str As String) As MyColor
  197. Return New MyColor(str)
  198. End Operator
  199. Public Shared Widening Operator CType(col As Color) As MyColor
  200. Return New MyColor(col)
  201. End Operator
  202. Public Shared Widening Operator CType(conv As MyColor) As Color
  203. Return Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B))
  204. End Operator
  205. Public Shared Widening Operator CType(conv As MyColor) As System.Drawing.Color
  206. Return System.Drawing.Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B))
  207. End Operator
  208. Public Shared Widening Operator CType(bru As SolidColorBrush) As MyColor
  209. Return New MyColor(bru.Color)
  210. End Operator
  211. Public Shared Widening Operator CType(conv As MyColor) As SolidColorBrush
  212. Return New SolidColorBrush(Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B)))
  213. End Operator
  214. Public Shared Widening Operator CType(bru As Brush) As MyColor
  215. Return New MyColor(bru)
  216. End Operator
  217. Public Shared Widening Operator CType(conv As MyColor) As Brush
  218. Return New SolidColorBrush(Color.FromArgb(DoubleToByte(conv.A), DoubleToByte(conv.R), DoubleToByte(conv.G), DoubleToByte(conv.B)))
  219. End Operator
  220. '颜色运算
  221. Public Shared Operator +(a As MyColor, b As MyColor) As MyColor
  222. Return New MyColor With {.A = a.A + b.A, .B = a.B + b.B, .G = a.G + b.G, .R = a.R + b.R}
  223. End Operator
  224. Public Shared Operator -(a As MyColor, b As MyColor) As MyColor
  225. Return New MyColor With {.A = a.A - b.A, .B = a.B - b.B, .G = a.G - b.G, .R = a.R - b.R}
  226. End Operator
  227. Public Shared Operator *(a As MyColor, b As Double) As MyColor
  228. Return New MyColor With {.A = a.A * b, .B = a.B * b, .G = a.G * b, .R = a.R * b}
  229. End Operator
  230. Public Shared Operator /(a As MyColor, b As Double) As MyColor
  231. Return New MyColor With {.A = a.A / b, .B = a.B / b, .G = a.G / b, .R = a.R / b}
  232. End Operator
  233. Public Shared Operator =(a As MyColor, b As MyColor) As Boolean
  234. If IsNothing(a) AndAlso IsNothing(b) Then Return True
  235. If IsNothing(a) OrElse IsNothing(b) Then Return False
  236. Return a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B
  237. End Operator
  238. Public Shared Operator <>(a As MyColor, b As MyColor) As Boolean
  239. If IsNothing(a) AndAlso IsNothing(b) Then Return False
  240. If IsNothing(a) OrElse IsNothing(b) Then Return True
  241. Return Not (a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B)
  242. End Operator
  243. ''' <summary>
  244. ''' 获取两颜色间的百分比,基于 RGB 计算。
  245. ''' </summary>
  246. Public Shared Function Lerp(ValueA As MyColor, ValueB As MyColor, Percent As Double) As MyColor
  247. Return Round(ValueA * (1 - Percent) + ValueB * Percent, 6)
  248. End Function
  249. Public Shared Function Round(col As MyColor, Optional w As Integer = 0) As MyColor
  250. 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)}
  251. End Function
  252. ''' <summary>
  253. ''' 将一个数字限制为 0~255 的 Byte 值。
  254. ''' </summary>
  255. Public Shared Function DoubleToByte(d As Double) As Byte
  256. If d < 0 Then d = 0
  257. If d > 255 Then d = 255
  258. Return Math.Round(d)
  259. End Function
  260. '构造函数
  261. Public Sub New()
  262. End Sub
  263. Public Sub New(col As Color)
  264. Me.A = col.A
  265. Me.R = col.R
  266. Me.G = col.G
  267. Me.B = col.B
  268. End Sub
  269. Public Sub New(HexString As String)
  270. Dim StringColor As Media.Color = ColorConverter.ConvertFromString(HexString)
  271. A = StringColor.A
  272. R = StringColor.R
  273. G = StringColor.G
  274. B = StringColor.B
  275. End Sub
  276. Public Sub New(newA As Double, col As MyColor)
  277. Me.A = newA
  278. Me.R = col.R
  279. Me.G = col.G
  280. Me.B = col.B
  281. End Sub
  282. Public Sub New(newR As Double, newG As Double, newB As Double)
  283. Me.A = 255
  284. Me.R = newR
  285. Me.G = newG
  286. Me.B = newB
  287. End Sub
  288. Public Sub New(newA As Double, newR As Double, newG As Double, newB As Double)
  289. Me.A = newA
  290. Me.R = newR
  291. Me.G = newG
  292. Me.B = newB
  293. End Sub
  294. Public Sub New(brush As Brush)
  295. Dim Color As Color = CType(brush, SolidColorBrush).Color
  296. A = Color.A
  297. R = Color.R
  298. G = Color.G
  299. B = Color.B
  300. End Sub
  301. Public Sub New(brush As SolidColorBrush)
  302. Dim Color As Color = brush.Color
  303. A = Color.A
  304. R = Color.R
  305. G = Color.G
  306. B = Color.B
  307. End Sub
  308. Public Sub New(obj As Object)
  309. If obj Is Nothing Then
  310. A = 255 : R = 255 : G = 255 : B = 255
  311. Else
  312. If TypeOf obj Is SolidColorBrush Then
  313. '避免反复获取 Color 对象造成性能下降
  314. Dim Color As Color = CType(obj, SolidColorBrush).Color
  315. A = Color.A
  316. R = Color.R
  317. G = Color.G
  318. B = Color.B
  319. Else
  320. A = obj.A
  321. R = obj.R
  322. G = obj.G
  323. B = obj.B
  324. End If
  325. End If
  326. End Sub
  327. 'HSL
  328. Public Function Hue(v1 As Double, v2 As Double, vH As Double) As Double
  329. If vH < 0 Then vH += 1
  330. If vH > 1 Then vH -= 1
  331. If vH < 0.16667 Then Return v1 + (v2 - v1) * 6 * vH
  332. If vH < 0.5 Then Return v2
  333. If vH < 0.66667 Then Return v1 + (v2 - v1) * (4 - vH * 6)
  334. Return v1
  335. End Function
  336. Public Function FromHSL(sH As Double, sS As Double, sL As Double) As MyColor
  337. If sS = 0 Then
  338. R = sL * 2.55
  339. G = R
  340. B = R
  341. Else
  342. Dim H = sH / 360
  343. Dim S = sS / 100
  344. Dim L = sL / 100
  345. S = If(L < 0.5, S * L + L, S * (1.0 - L) + L)
  346. L = 2 * L - S
  347. R = 255 * Hue(L, S, H + 1 / 3)
  348. G = 255 * Hue(L, S, H)
  349. B = 255 * Hue(L, S, H - 1 / 3)
  350. End If
  351. A = 255
  352. Return Me
  353. End Function
  354. Public Function FromHSL2(sH As Double, sS As Double, sL As Double) As MyColor
  355. If sS = 0 Then
  356. R = sL * 2.55 : G = R : B = R
  357. Else
  358. '初始化
  359. sH = (sH + 3600000) Mod 360
  360. Dim cent As Double() = {
  361. +0.1, -0.06, -0.3, '0, 30, 60
  362. -0.19, -0.15, -0.24, '90, 120, 150
  363. -0.32, -0.09, +0.18, '180, 210, 240
  364. +0.05, -0.12, -0.02, '270, 300, 330
  365. +0.1, -0.06} '最后两位与前两位一致,加是变亮,减是变暗
  366. '计算色调对应的亮度片区
  367. Dim center As Double = sH / 30.0
  368. Dim intCenter As Integer = Math.Floor(center) '亮度片区编号
  369. center = 50 - (
  370. (1 - center + intCenter) * cent(intCenter) + (center - intCenter) * cent(intCenter + 1)
  371. ) * sS
  372. 'center = 50 + (cent(intCenter) + (center - intCenter) * (cent(intCenter + 1) - cent(intCenter))) * sS
  373. sL = If(sL < center, sL / center, 1 + (sL - center) / (100 - center)) * 50
  374. FromHSL(sH, sS, sL)
  375. End If
  376. A = 255
  377. Return Me
  378. End Function
  379. Public Overrides Function ToString() As String
  380. Return "(" & A & "," & R & "," & G & "," & B & ")"
  381. End Function
  382. Public Overrides Function Equals(obj As Object) As Boolean
  383. Return Me = obj
  384. End Function
  385. End Class
  386. ''' <summary>
  387. ''' 支持负数与浮点数的矩形。
  388. ''' </summary>
  389. Public Class MyRect
  390. '属性
  391. Public Property Width As Double = 0
  392. Public Property Height As Double = 0
  393. Public Property Left As Double = 0
  394. Public Property Top As Double = 0
  395. '构造函数
  396. Public Sub New()
  397. End Sub
  398. Public Sub New(left As Double, top As Double, width As Double, height As Double)
  399. Me.Left = left
  400. Me.Top = top
  401. Me.Width = width
  402. Me.Height = height
  403. End Sub
  404. End Class
  405. ''' <summary>
  406. ''' 模块加载状态枚举。
  407. ''' </summary>
  408. Public Enum LoadState
  409. Waiting
  410. Loading
  411. Finished
  412. Failed
  413. Interrupted
  414. End Enum
  415. ''' <summary>
  416. ''' 执行返回值。
  417. ''' </summary>
  418. Public Enum ProcessReturnValues
  419. ''' <summary>
  420. ''' 执行成功。
  421. ''' </summary>
  422. Success = 0
  423. ''' <summary>
  424. ''' 执行失败。
  425. ''' </summary>
  426. Fail = 1
  427. ''' <summary>
  428. ''' 执行时出现未经处理的异常。
  429. ''' </summary>
  430. Exception = 2
  431. ''' <summary>
  432. ''' 执行超时。
  433. ''' </summary>
  434. Timeout = 3
  435. ''' <summary>
  436. ''' 取消执行。可能是由于不满足执行的前置条件。
  437. ''' </summary>
  438. Cancel = 4
  439. ''' <summary>
  440. ''' 任务成功完成。
  441. ''' </summary>
  442. TaskDone = 5
  443. End Enum
  444. ''' <summary>
  445. ''' 可以使用 Equals 和等号的 List。
  446. ''' </summary>
  447. Public Class EqualableList(Of T)
  448. Inherits List(Of T)
  449. Public Overrides Function Equals(obj As Object) As Boolean
  450. If TryCast(obj, List(Of T)) Is Nothing Then
  451. '类型不同
  452. Return False
  453. Else
  454. '类型相同
  455. Dim objList As List(Of T) = obj
  456. If objList.Count <> Count Then Return False
  457. For i = 0 To objList.Count - 1
  458. If Not objList(i).Equals(Me(i)) Then Return False
  459. Next
  460. Return True
  461. End If
  462. End Function
  463. Public Shared Operator =(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  464. Return EqualityComparer(Of EqualableList(Of T)).Default.Equals(left, right)
  465. End Operator
  466. Public Shared Operator <>(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  467. Return Not left = right
  468. End Operator
  469. End Class
  470. #End Region
  471. #Region "文件"
  472. '=============================
  473. ' 注册表
  474. '=============================
  475. ''' <summary>
  476. ''' 读取注册表键。如果失败则返回默认值。
  477. ''' </summary>
  478. Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
  479. Try
  480. Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
  481. Catch ex As Exception
  482. Log(ex, "读取注册表出错:" & Key, NotifyLevel.AllUsers)
  483. Return DefaultValue
  484. End Try
  485. End Function
  486. ''' <summary>
  487. ''' 写入注册表键。
  488. ''' </summary>
  489. Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
  490. Try
  491. Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
  492. If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建
  493. SubKey.SetValue(Key, Value)
  494. Catch ex As Exception
  495. Log(ex, "写入注册表出错:" & Key, If(ThrowException, NotifyLevel.AllUsers, NotifyLevel.DevelopOnly))
  496. If ThrowException Then Throw
  497. End Try
  498. End Sub
  499. ''' <summary>
  500. ''' 是否存在某个注册表键。
  501. ''' </summary>
  502. Public Function HasReg(Key As String) As Boolean
  503. Return ReadReg(Key, Nothing) IsNot Nothing
  504. End Function
  505. ''' <summary>
  506. ''' 删除注册表键。
  507. ''' </summary>
  508. Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
  509. Try
  510. Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
  511. If SubKey?.GetValue(Key) Is Nothing Then Return
  512. SubKey.DeleteValue(Key)
  513. Catch ex As Exception
  514. Log(ex, "删除注册表出错:" & Key, If(ThrowException, NotifyLevel.AllUsers, NotifyLevel.DevelopOnly))
  515. If ThrowException Then Throw
  516. End Try
  517. End Sub
  518. '=============================
  519. ' ini
  520. '=============================
  521. Private ReadOnly IniCache As New ConcurrentDictionary(Of String, ConcurrentDictionary(Of String, String))
  522. ''' <summary>
  523. ''' 清除某 ini 文件的运行时缓存。
  524. ''' </summary>
  525. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  526. Public Sub IniClearCache(FileName As String)
  527. If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
  528. IniCache.Remove(FileName)
  529. End Sub
  530. ''' <summary>
  531. ''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
  532. ''' 在文件不存在或读取失败时返回 Nothing。
  533. ''' </summary>
  534. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  535. Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String)
  536. Try
  537. '还原文件路径
  538. If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
  539. '检索缓存
  540. Dim Cache As ConcurrentDictionary(Of String, String) = Nothing
  541. If IniCache.TryGetValue(FileName, Cache) Then Return Cache
  542. '读取文件
  543. If Not File.Exists(FileName) Then Return Nothing
  544. Dim Ini As New ConcurrentDictionary(Of String, String)
  545. For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
  546. Dim Index As Integer = Line.IndexOfF(":")
  547. If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
  548. Next
  549. IniCache(FileName) = Ini
  550. Return Ini
  551. Catch ex As Exception
  552. Log(ex, $"生成 ini 文件缓存失败({FileName})", NotifyLevel.AllUsers)
  553. Return Nothing
  554. End Try
  555. End Function
  556. ''' <summary>
  557. ''' 读取 ini 文件。这可能会使用到缓存。
  558. ''' </summary>
  559. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  560. ''' <param name="Key">键。</param>
  561. ''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
  562. Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
  563. Dim Content = IniGetContent(FileName)
  564. If Content Is Nothing Then Return DefaultValue
  565. Return Content.GetOrDefault(Key, DefaultValue)
  566. End Function
  567. ''' <summary>
  568. ''' 判断 ini 文件中是否包含某个键。这可能会使用到缓存。
  569. ''' </summary>
  570. Public Function HasIniKey(FileName As String, Key As String) As Boolean
  571. Dim Content = IniGetContent(FileName)
  572. Return Content IsNot Nothing AndAlso Content.ContainsKey(Key)
  573. End Function
  574. ''' <summary>
  575. ''' 从 ini 文件中移除某个键。这会更新缓存。
  576. ''' </summary>
  577. Public Sub DeleteIniKey(FileName As String, Key As String)
  578. WriteIni(FileName, Key, Nothing)
  579. End Sub
  580. ''' <summary>
  581. ''' 写入 ini 文件,这会更新缓存。
  582. ''' 若 Value 为 Nothing,则删除该键。
  583. ''' </summary>
  584. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  585. ''' <param name="Key">键。</param>
  586. ''' <param name="Value">值。</param>
  587. Public Sub WriteIni(FileName As String, Key As String, Value As String)
  588. Try
  589. '预处理
  590. If Key.Contains(":") Then Throw New Exception($"尝试写入 ini 文件 {FileName} 的键名中包含了冒号:{Key}")
  591. Key = Key.ReplaceLineEndings("")
  592. Value = Value?.ReplaceLineEndings("")
  593. '获取目前文件
  594. Dim Content = IniGetContent(FileName)
  595. If Content Is Nothing Then Content = New ConcurrentDictionary(Of String, String)
  596. '更新值
  597. If Value Is Nothing Then
  598. If Not Content.Remove(Key) Then Return '无需处理
  599. Else
  600. Dim ExistingValue As String = Nothing
  601. If Content.TryGetValue(Key, ExistingValue) AndAlso ExistingValue = Value Then Return '无需处理
  602. Content(Key) = Value
  603. End If
  604. '写入文件
  605. Dim FileContent As New StringBuilder
  606. For Each Pair In Content
  607. FileContent.Append(Pair.Key)
  608. FileContent.Append(":")
  609. FileContent.Append(Pair.Value)
  610. FileContent.Append(vbCrLf)
  611. Next
  612. If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
  613. '处理相对路径
  614. FileName = If(FileName.Contains(":\"), FileName, PathExeFolder & FileName)
  615. FileUtils.Write(FileName, FileContent.ToString)
  616. Catch ex As Exception
  617. Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", NotifyLevel.AllUsers)
  618. End Try
  619. End Sub
  620. '路径处理
  621. ''' <summary>
  622. ''' 从文件路径或者 URL 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
  623. ''' 取决于原路径格式,路径以 / 或 \ 结尾。
  624. ''' 不包含路径将会抛出异常。
  625. ''' </summary>
  626. Public Function GetPathFromFullPath(FullName As String) As String
  627. If String.IsNullOrEmpty(FullName) OrElse Not (FullName.Contains("\") OrElse FullName.Contains("/")) Then Throw New ArgumentException("参数不包含路径:" & FullName)
  628. If FullName.EndsWithF("\") OrElse FullName.EndsWithF("/") Then
  629. '是文件夹路径
  630. Dim IsRight As Boolean = FullName.EndsWithF("\")
  631. FullName = Left(FullName, Len(FullName) - 1)
  632. GetPathFromFullPath = Left(FullName, FullName.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
  633. Else
  634. '是文件路径
  635. GetPathFromFullPath = Left(FullName, FullName.LastIndexOfAny({"\", "/"}) + 1)
  636. If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FullName)
  637. End If
  638. End Function
  639. ''' <summary>
  640. ''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。
  641. ''' </summary>
  642. Public Function GetFileNameFromPath(FilePath As String) As String
  643. FilePath = FilePath.Replace("/", "\")
  644. If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
  645. If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
  646. If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
  647. Dim length As Integer = FilePath.Length
  648. If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
  649. Return FilePath
  650. End Function
  651. ''' <summary>
  652. ''' 从文件夹路径获取文件夹名。
  653. ''' </summary>
  654. Public Function GetFolderNameFromPath(FolderPath As String) As String
  655. If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
  656. If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
  657. Return GetFileNameFromPath(FolderPath)
  658. End Function
  659. '读取、复制文件
  660. ''' <summary>
  661. ''' 复制文件。会自动创建文件夹、会覆盖已有的文件。
  662. ''' </summary>
  663. Public Sub CopyFile(FromPath As String, ToPath As String)
  664. Try
  665. '还原文件路径
  666. FromPath = If(FromPath.Contains(":\"), FromPath, PathExeFolder & FromPath)
  667. ToPath = If(ToPath.Contains(":\"), ToPath, PathExeFolder & ToPath)
  668. '如果复制同一个文件则跳过
  669. If FromPath = ToPath Then Return
  670. '确保目录存在
  671. DirectoryUtils.Create(ToPath, isFilePath:=True)
  672. '复制文件
  673. File.Copy(FromPath, ToPath, True)
  674. Catch ex As Exception
  675. Throw New Exception("复制文件出错:" & FromPath & " → " & ToPath, ex)
  676. End Try
  677. End Sub
  678. ''' <summary>
  679. ''' 读取文件,如果失败则返回空数组。
  680. ''' </summary>
  681. Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
  682. Try
  683. '还原文件路径
  684. If Not FilePath.Contains(":\") Then FilePath = PathExeFolder & FilePath
  685. If File.Exists(FilePath) Then
  686. Dim FileBytes As Byte()
  687. Using ReadStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
  688. ReDim FileBytes(ReadStream.Length - 1)
  689. ReadStream.Read(FileBytes, 0, ReadStream.Length)
  690. End Using
  691. Return FileBytes
  692. Else
  693. Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
  694. Return {}
  695. End If
  696. Catch ex As Exception
  697. Log(ex, "读取文件出错:" & FilePath)
  698. Return {}
  699. End Try
  700. End Function
  701. ''' <summary>
  702. ''' 读取文件,如果失败则返回空字符串。
  703. ''' </summary>
  704. ''' <param name="FilePath">文件完整或相对路径。</param>
  705. Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
  706. Dim FileBytes = ReadFileBytes(FilePath)
  707. ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
  708. End Function
  709. ''' <summary>
  710. ''' 读取流中的所有文本。
  711. ''' </summary>
  712. Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
  713. Try
  714. Dim srcBuf As Byte() = New Byte(16384) {}
  715. Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
  716. Dim Result As New List(Of Byte)
  717. While DataCount > 0
  718. If DataCount > 0 Then Result.AddRange(srcBuf.ToList.GetRange(0, DataCount))
  719. DataCount = Stream.Read(srcBuf, 0, 16384)
  720. End While
  721. Dim Bts = Result.ToArray
  722. Return If(Encoding, GetEncoding(Bts)).GetString(Bts)
  723. Catch ex As Exception
  724. Log(ex, "读取流出错")
  725. Return ""
  726. End Try
  727. End Function
  728. '文件编码
  729. ''' <summary>
  730. ''' 根据字节数组分析其编码。
  731. ''' </summary>
  732. Public Function GetEncoding(Bytes As Byte()) As Encoding
  733. Dim Length As Integer = Bytes.Count
  734. If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  735. '根据 BOM 判断编码
  736. If Bytes(0) >= &HEF Then
  737. '有 BOM 类型
  738. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  739. Return New UTF8Encoding(True) '带 BOM 的 UTF8
  740. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  741. Return Encoding.BigEndianUnicode
  742. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  743. Return Encoding.Unicode
  744. Else
  745. Return Encoding.GetEncoding("GB18030")
  746. End If
  747. End If
  748. '无 BOM 文件:GB18030(ANSI)或 UTF8
  749. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  750. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  751. If UTF8.Contains(ErrorChar) Then
  752. Return Encoding.GetEncoding("GB18030")
  753. Else
  754. Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  755. End If
  756. End Function
  757. ''' <summary>
  758. ''' 解码 Bytes。
  759. ''' </summary>
  760. Public Function DecodeBytes(Bytes As Byte()) As String
  761. Dim Length As Integer = Bytes.Length
  762. If Length < 3 Then Return Encoding.UTF8.GetString(Bytes)
  763. '根据 BOM 判断编码
  764. If Bytes(0) >= &HEF Then
  765. '有 BOM 类型
  766. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  767. Return Encoding.UTF8.GetString(Bytes, 3, Length - 3)
  768. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  769. Return Encoding.BigEndianUnicode.GetString(Bytes, 3, Length - 3)
  770. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  771. Return Encoding.Unicode.GetString(Bytes, 3, Length - 3)
  772. Else
  773. Return Encoding.GetEncoding("GB18030").GetString(Bytes, 3, Length - 3)
  774. End If
  775. End If
  776. '无 BOM 文件:GB18030(ANSI)或 UTF8
  777. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  778. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  779. If UTF8.Contains(ErrorChar) Then
  780. Return Encoding.GetEncoding("GB18030").GetString(Bytes)
  781. Else
  782. Return UTF8
  783. End If
  784. End Function
  785. '对话框
  786. ''' <summary>
  787. ''' 弹出保存对话框并且要求保存位置,返回用户输入的完整路径。
  788. ''' </summary>
  789. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  790. ''' <param name="Title">弹窗的标题。</param>
  791. ''' <param name="FileName">默认的文件名。</param>
  792. Public Function SelectSaveFile(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional InitialDirectory As String = Nothing) As String
  793. Using fileDialog As New Forms.SaveFileDialog
  794. fileDialog.AddExtension = True
  795. fileDialog.AutoUpgradeEnabled = True
  796. fileDialog.Title = Title
  797. fileDialog.FileName = FileName
  798. If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
  799. If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
  800. fileDialog.ShowDialog()
  801. SelectSaveFile = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
  802. Log("[UI] 选择文件返回:" & SelectSaveFile)
  803. End Using
  804. End Function
  805. ''' <summary>
  806. ''' 弹出选取文件对话框,要求选择一个文件。
  807. ''' </summary>
  808. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  809. ''' <param name="Title">弹窗的标题。</param>
  810. Public Function SelectFile(FileFilter As String, Title As String, Optional InitialDirectory As String = Nothing) As String
  811. Using fileDialog As New Forms.OpenFileDialog
  812. fileDialog.AddExtension = True
  813. fileDialog.AutoUpgradeEnabled = True
  814. fileDialog.CheckFileExists = True
  815. fileDialog.Filter = FileFilter
  816. fileDialog.Multiselect = False
  817. fileDialog.Title = Title
  818. fileDialog.ValidateNames = True
  819. If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
  820. fileDialog.ShowDialog()
  821. Log("[UI] 选择单个文件返回:" & fileDialog.FileName)
  822. Return fileDialog.FileName
  823. End Using
  824. End Function
  825. ''' <summary>
  826. ''' 弹出选取文件对话框,要求选择多个文件。
  827. ''' </summary>
  828. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  829. ''' <param name="Title">弹窗的标题。</param>
  830. Public Function SelectFiles(FileFilter As String, Title As String) As String()
  831. Using fileDialog As New Forms.OpenFileDialog
  832. fileDialog.AddExtension = True
  833. fileDialog.AutoUpgradeEnabled = True
  834. fileDialog.CheckFileExists = True
  835. fileDialog.Filter = FileFilter
  836. fileDialog.Multiselect = True
  837. fileDialog.Title = Title
  838. fileDialog.ValidateNames = True
  839. fileDialog.ShowDialog()
  840. Log("[UI] 选择多个文件返回:" & fileDialog.FileNames.Join(","))
  841. Return fileDialog.FileNames
  842. End Using
  843. End Function
  844. ''' <summary>
  845. ''' 弹出选取文件夹对话框,要求选取文件夹。
  846. ''' 返回以 \ 结尾的完整路径,如果没有选择则返回空字符串。
  847. ''' </summary>
  848. Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
  849. Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
  850. folderDialog.ShowDialog()
  851. SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
  852. Log("[UI] 选择文件夹返回:" & SelectFolder)
  853. End Function
  854. '文件校验
  855. ''' <summary>
  856. ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在,会返回 False。
  857. ''' </summary>
  858. Public Function CheckPermission(Folder As String) As Boolean
  859. Try
  860. If String.IsNullOrEmpty(Folder) Then Return False
  861. If Not Folder.EndsWithF("\") Then Folder += "\"
  862. If Folder.EndsWithF(":\System Volume Information\") OrElse Folder.EndsWithF(":\$RECYCLE.BIN\") Then Return False
  863. If Not Directory.Exists(Folder) Then Return False
  864. Dim FileName As String = "CheckPermission" & GetUuid()
  865. If File.Exists(Folder & FileName) Then File.Delete(Folder & FileName)
  866. File.Create(Folder & FileName).Dispose()
  867. File.Delete(Folder & FileName)
  868. Return True
  869. Catch ex As Exception
  870. Log(ex, "没有对文件夹 " & Folder & " 的权限,请尝试以管理员权限运行 PCL")
  871. Return False
  872. End Try
  873. End Function
  874. ''' <summary>
  875. ''' 检查是否拥有某一文件夹的 I/O 权限。如果出错,则抛出异常。
  876. ''' </summary>
  877. Public Sub CheckPermissionWithException(Folder As String)
  878. If String.IsNullOrWhiteSpace(Folder) Then Throw New ArgumentNullException("文件夹名不能为空!")
  879. If Not Folder.EndsWithF("\") Then Folder += "\"
  880. If Not Directory.Exists(Folder) Then Throw New DirectoryNotFoundException("文件夹不存在!")
  881. If File.Exists(Folder & "CheckPermission") Then File.Delete(Folder & "CheckPermission")
  882. File.Create(Folder & "CheckPermission").Dispose()
  883. File.Delete(Folder & "CheckPermission")
  884. End Sub
  885. ''' <summary>
  886. ''' 获取文件 MD5,若失败则返回空字符串。
  887. ''' </summary>
  888. Public Function GetFileMD5(FilePath As String) As String
  889. Dim Retried As Boolean = False
  890. Re:
  891. Try
  892. Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  893. Using h = MD5Cng.Create()
  894. Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
  895. End Using
  896. End Using
  897. Catch ex As Exception
  898. If Retried OrElse TypeOf ex Is FileNotFoundException Then
  899. Log(ex, "获取文件 MD5 失败:" & FilePath)
  900. Return ""
  901. Else
  902. Retried = True
  903. Log(ex, "获取文件 MD5 可重试失败:" & FilePath, NotifyLevel.Silent)
  904. Thread.Sleep(RandomInteger(200, 500))
  905. GoTo Re
  906. End If
  907. End Try
  908. End Function
  909. ''' <summary>
  910. ''' 获取文件 SHA512,若失败则返回空字符串。
  911. ''' </summary>
  912. Public Function GetFileSHA512(FilePath As String) As String
  913. Dim Retried As Boolean = False
  914. Re:
  915. Try
  916. Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  917. Using h = SHA512Cng.Create()
  918. Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
  919. End Using
  920. End Using
  921. Catch ex As Exception
  922. If Retried OrElse TypeOf ex Is FileNotFoundException Then
  923. Log(ex, "获取文件 SHA512 失败:" & FilePath)
  924. Return ""
  925. Else
  926. Retried = True
  927. Log(ex, "获取文件 SHA512 可重试失败:" & FilePath, NotifyLevel.Silent)
  928. Thread.Sleep(RandomInteger(200, 500))
  929. GoTo Re
  930. End If
  931. End Try
  932. End Function
  933. ''' <summary>
  934. ''' 获取文件 SHA256,若失败则返回空字符串。
  935. ''' </summary>
  936. Public Function GetFileSHA256(FilePath As String) As String
  937. Dim Retry As Boolean = False
  938. Re:
  939. Try
  940. Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  941. Using h = SHA256Cng.Create()
  942. Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
  943. End Using
  944. End Using
  945. Catch ex As Exception
  946. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  947. Log(ex, "获取文件 SHA256 失败:" & FilePath)
  948. Return ""
  949. Else
  950. Retry = True
  951. Log(ex, "获取文件 SHA256 可重试失败:" & FilePath, NotifyLevel.Silent)
  952. Thread.Sleep(RandomInteger(200, 500))
  953. GoTo Re
  954. End If
  955. End Try
  956. End Function
  957. ''' <summary>
  958. ''' 获取文件 SHA1,若失败则返回空字符串。
  959. ''' </summary>
  960. Public Function GetFileSHA1(FilePath As String) As String
  961. Dim Retry As Boolean = False
  962. Re:
  963. Try
  964. Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  965. Using h = SHA1Cng.Create()
  966. Return BitConverter.ToString(h.ComputeHash(File)).Replace("-", "").Lower()
  967. End Using
  968. End Using
  969. Catch ex As Exception
  970. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  971. Log(ex, "获取文件 SHA1 失败:" & FilePath)
  972. Return ""
  973. Else
  974. Retry = True
  975. Log(ex, "获取文件 SHA1 可重试失败:" & FilePath, NotifyLevel.Silent)
  976. Thread.Sleep(RandomInteger(200, 500))
  977. GoTo Re
  978. End If
  979. End Try
  980. End Function
  981. ''' <summary>
  982. ''' 文件的校验规则。
  983. ''' </summary>
  984. Public Class FileChecker
  985. ''' <summary>
  986. ''' 文件的准确大小。
  987. ''' 不检查则为 -1。
  988. ''' </summary>
  989. Public ActualSize As Long = -1
  990. ''' <summary>
  991. ''' 文件的最小大小。
  992. ''' 不检查则为 -1。
  993. ''' </summary>
  994. Public MinSize As Long = -1
  995. ''' <summary>
  996. ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
  997. ''' 不检查则为 Nothing。
  998. ''' </summary>
  999. Public Hash As String = Nothing
  1000. ''' <summary>
  1001. ''' 是否可以使用已经存在的文件。
  1002. ''' </summary>
  1003. Public CanUseExistsFile As Boolean = True
  1004. ''' <summary>
  1005. ''' 是否要求为 JSON 文件。
  1006. ''' 即,开头结尾必须为 {} 或 []。
  1007. ''' </summary>
  1008. Public IsJson As Boolean = False
  1009. 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)
  1010. Me.ActualSize = ActualSize
  1011. Me.MinSize = MinSize
  1012. Me.Hash = Hash
  1013. Me.CanUseExistsFile = CanUseExistsFile
  1014. Me.IsJson = IsJson
  1015. End Sub
  1016. ''' <summary>
  1017. ''' 检查文件。若成功则返回 Nothing,失败则返回错误的描述文本,描述文本不以句号结尾。不会抛出错误。
  1018. ''' </summary>
  1019. Public Function Check(LocalPath As String) As String
  1020. Try
  1021. Dim Info As New FileInfo(LocalPath)
  1022. If Not Info.Exists Then Return "文件不存在:" & LocalPath
  1023. Dim FileSize As Long = Info.Length
  1024. If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
  1025. Return $"文件大小应为 {ActualSize} B,实际为 {FileSize} B" &
  1026. If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
  1027. End If
  1028. If MinSize >= 0 AndAlso MinSize > FileSize Then
  1029. Return $"文件大小应大于 {MinSize} B,实际为 {FileSize} B" &
  1030. If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
  1031. End If
  1032. If Not String.IsNullOrEmpty(Hash) Then
  1033. If Hash.Length < 35 Then 'MD5
  1034. If Hash.Lower <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
  1035. ElseIf Hash.Length = 64 Then 'SHA256
  1036. If Hash.Lower <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
  1037. Else 'SHA1 (40)
  1038. If Hash.Lower <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
  1039. End If
  1040. End If
  1041. If IsJson Then
  1042. Dim Content As String = ReadFile(LocalPath)
  1043. If Content = "" Then Throw New Exception("读取到的文件为空")
  1044. Try
  1045. GetJson(Content)
  1046. Catch ex As Exception
  1047. Throw New Exception("不是有效的 json 文件", ex)
  1048. End Try
  1049. End If
  1050. Return Nothing
  1051. Catch ex As Exception
  1052. Log(ex, "检查文件出错")
  1053. Return ex.GetBrief()
  1054. End Try
  1055. End Function
  1056. End Class
  1057. '压缩文件
  1058. ''' <summary>
  1059. ''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
  1060. ''' 会尝试创建目标文件夹;会覆盖已有文件,不会删除多余文件。
  1061. ''' 会先使用 UTF-8 解压,失败后换用 GB18030 解压。
  1062. ''' </summary>
  1063. Public Sub ExtractCompressedFile(CompressFilePath As String, DestDirectory As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
  1064. DestDirectory = DirectoryUtils.ToDirectoryFormat(DestDirectory)
  1065. DirectoryUtils.Create(DestDirectory)
  1066. '解压 gz(gz 不需要考虑编码)
  1067. If CompressFilePath.EndsWithF(".gz", True) Then
  1068. Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
  1069. Using decompressedFile As New FileStream(
  1070. DestDirectory & GetFileNameFromPath(CompressFilePath).Lower.Replace(".tar", "").Replace(".gz", ""), FileMode.Create, FileAccess.Write)
  1071. stream.CopyTo(decompressedFile)
  1072. End Using
  1073. End Using
  1074. Return
  1075. End If
  1076. '解压 zip
  1077. Dim TryExtractZip =
  1078. Sub(Encoding As Encoding)
  1079. Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, Encoding)
  1080. Dim EntryCount = Archive.Entries.Count
  1081. For Each Entry In Archive.Entries
  1082. If ProgressIncrementHandler IsNot Nothing AndAlso EntryCount > 0 Then ProgressIncrementHandler(1 / EntryCount)
  1083. Dim Destination As String = Path.Combine(DestDirectory, Entry.FullName)
  1084. If Not Path.GetFullPath(Destination).StartsWithF(Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
  1085. If DirectoryUtils.IsDirectoryFormat(Destination) Then Continue For '不创建空文件夹
  1086. Destination = FileUtils.ShortenPath(Destination)
  1087. DirectoryUtils.Create(Destination, isFilePath:=True)
  1088. Entry.ExtractToFile(Destination, True) '#7329
  1089. Next
  1090. End Using
  1091. End Sub
  1092. Try
  1093. TryExtractZip(New UTF8Encoding(False, True))
  1094. Catch ex As Exception
  1095. Log(ex, $"首次解压尝试失败,将更换编码并重试({CompressFilePath} → {DestDirectory})")
  1096. Try
  1097. TryExtractZip(Encoding.GetEncoding("GB18030"))
  1098. Catch
  1099. Throw
  1100. End Try
  1101. End Try
  1102. End Sub
  1103. ''' <summary>
  1104. ''' 将多个文件打包为一个压缩文件。
  1105. ''' 这些文件会被直接放在压缩包根目录下。
  1106. ''' </summary>
  1107. Public Sub CreateCompressedFile(OutputFullPath As String, SourceFiles As IEnumerable(Of String))
  1108. DirectoryUtils.Create(OutputFullPath, isFilePath:=True)
  1109. Using ZipStream As New FileStream(OutputFullPath, FileMode.Create)
  1110. Using Archive As New ZipArchive(ZipStream, ZipArchiveMode.Create)
  1111. For Each FilePath In SourceFiles
  1112. If Not File.Exists(FilePath) Then Return
  1113. Using SourceStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.Read),
  1114. EntryStream As Stream = Archive.CreateEntry(Path.GetFileName(FilePath), CompressionLevel.Optimal).Open()
  1115. SourceStream.CopyTo(EntryStream)
  1116. End Using
  1117. Next
  1118. End Using
  1119. End Using
  1120. End Sub
  1121. ''' <summary>
  1122. ''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
  1123. ''' </summary>
  1124. Public Function DeleteDirectory(Folder As String, Optional IgnoreIssue As Boolean = False) As Integer
  1125. If Not Directory.Exists(Folder) Then Return 0
  1126. If Not Folder.EndsWithF("\") Then Folder &= "\"
  1127. If Folder.EndsWithF(":\") OrElse
  1128. Folder = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
  1129. Folder = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
  1130. Folder = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
  1131. Throw New UnauthorizedAccessException("这是重要的系统文件夹,无法删除:" & Folder)
  1132. End If
  1133. '实际删除
  1134. Dim DeletedCount As Integer = 0
  1135. Dim Files As String()
  1136. Try
  1137. Files = Directory.GetFiles(Folder)
  1138. Catch ex As DirectoryNotFoundException '#4549,也可能已被其他线程删除
  1139. If Directory.Exists(Folder) Then
  1140. Log(ex, $"疑似为孤立符号链接,尝试直接删除({Folder})", NotifyLevel.DevelopOnly)
  1141. Directory.Delete(Folder)
  1142. End If
  1143. Return DeletedCount
  1144. End Try
  1145. For Each FilePath As String In Files
  1146. Dim RetriedFile As Boolean = False
  1147. RetryFile:
  1148. Try
  1149. File.Delete(FilePath)
  1150. DeletedCount += 1
  1151. Catch ex As DirectoryNotFoundException
  1152. Return DeletedCount
  1153. Catch ex As Exception
  1154. If Not RetriedFile Then
  1155. RetriedFile = True
  1156. Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
  1157. Thread.Sleep(300)
  1158. GoTo RetryFile
  1159. ElseIf IgnoreIssue Then
  1160. Log(ex, "删除单个文件可忽略地失败")
  1161. Else
  1162. Throw
  1163. End If
  1164. End Try
  1165. Next
  1166. For Each str As String In Directory.GetDirectories(Folder)
  1167. DeleteDirectory(str, IgnoreIssue)
  1168. Next
  1169. Dim RetriedDir As Boolean = False
  1170. RetryDir:
  1171. Try
  1172. Directory.Delete(Folder, True)
  1173. Catch ex As DirectoryNotFoundException
  1174. Catch ex As Exception
  1175. If Not RetriedDir AndAlso Not RunInUi() Then
  1176. RetriedDir = True
  1177. Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Folder})")
  1178. Thread.Sleep(300)
  1179. GoTo RetryDir
  1180. ElseIf IgnoreIssue Then
  1181. Log(ex, "删除单个文件夹可忽略地失败")
  1182. Else
  1183. Throw
  1184. End If
  1185. End Try
  1186. Return DeletedCount
  1187. End Function
  1188. ''' <summary>
  1189. ''' 复制文件夹,失败会抛出异常。
  1190. ''' </summary>
  1191. Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
  1192. FromPath = FromPath.Replace("/", "\")
  1193. If Not FromPath.EndsWithF("\") Then FromPath &= "\"
  1194. ToPath = ToPath.Replace("/", "\")
  1195. If Not ToPath.EndsWithF("\") Then ToPath &= "\"
  1196. Dim AllFiles = EnumerateFiles(FromPath).ToList
  1197. Dim FileCount As Long = AllFiles.Count
  1198. For Each File In AllFiles
  1199. CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
  1200. If ProgressIncrementHandler IsNot Nothing AndAlso FileCount > 0 Then ProgressIncrementHandler(1 / FileCount)
  1201. Next
  1202. End Sub
  1203. ''' <summary>
  1204. ''' 遍历文件夹中的所有文件。
  1205. ''' </summary>
  1206. Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
  1207. Dim Info As New DirectoryInfo(Directory)
  1208. If Not Info.Exists Then Return New List(Of FileInfo)
  1209. Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
  1210. End Function
  1211. #End Region
  1212. #Region "文本"
  1213. Public vbLQ As Char = Convert.ToChar(8220)
  1214. Public vbRQ As Char = Convert.ToChar(8221)
  1215. ''' <summary>
  1216. ''' 提取 Exception 与 Inner Exception 的详细描述与堆栈信息。返回内容总是多于一行。
  1217. ''' </summary>
  1218. ''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
  1219. <Extension> Public Function GetDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
  1220. If Ex Is Nothing Then Return "无可用错误信息!"
  1221. '获取最底层的异常
  1222. Dim OuterEx As Exception = Ex
  1223. Dim InnerEx As Exception = Ex
  1224. Do Until InnerEx.InnerException Is Nothing
  1225. InnerEx = InnerEx.InnerException
  1226. Loop
  1227. '获取各级错误的描述与堆栈信息
  1228. Dim DescList As New List(Of String)
  1229. Dim IsInner As Boolean = False
  1230. Do Until Ex Is Nothing
  1231. DescList.Add(If(IsInner, "→ ", "") & Ex.Message.ReplaceLineEndings(vbCrLf, mergeMultiple:=True))
  1232. If Ex.StackTrace IsNot Nothing Then
  1233. For Each Stack As String In Ex.StackTrace.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
  1234. If ShowAllStacks OrElse Stack.ContainsIgnoreCase("pcl") Then
  1235. DescList.Add(Stack.ReplaceLineEndings(""))
  1236. End If
  1237. Next
  1238. End If
  1239. If Ex.GetType.FullName <> "System.Exception" Then DescList.Add(" 错误类型:" & Ex.GetType.FullName)
  1240. Ex = Ex.InnerException
  1241. IsInner = True
  1242. Loop
  1243. '构造输出信息
  1244. Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
  1245. If UsualReason Is Nothing Then
  1246. Return DescList.Join(vbCrLf)
  1247. Else
  1248. Return UsualReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
  1249. End If
  1250. End Function
  1251. ''' <summary>
  1252. ''' 提取 Exception 与 Inner Exception 的描述,汇总到一行。
  1253. ''' </summary>
  1254. <Extension> Public Function GetBrief(Ex As Exception) As String
  1255. If Ex Is Nothing Then Return "无可用错误信息!"
  1256. '获取最底层的异常
  1257. Dim OuterEx As Exception = Ex
  1258. Dim InnerEx As Exception = Ex
  1259. Do Until InnerEx.InnerException Is Nothing
  1260. InnerEx = InnerEx.InnerException
  1261. Loop
  1262. '获取各级错误的描述
  1263. Dim DescList As New List(Of String)
  1264. Do Until Ex Is Nothing
  1265. DescList.Add(Ex.Message.ReplaceLineEndings(" ", mergeMultiple:=True))
  1266. Ex = Ex.InnerException
  1267. Loop
  1268. DescList = DescList.Distinct.ToList
  1269. Dim Desc As String = DescList.Join(vbCrLf & "→ ")
  1270. '构造输出信息
  1271. Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
  1272. If UsualReason IsNot Nothing Then
  1273. Return UsualReason & "详细错误:" & DescList.First
  1274. Else
  1275. DescList.Reverse() '让最深层错误在最左边
  1276. Return DescList.Join(" ← ")
  1277. End If
  1278. End Function
  1279. Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
  1280. If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
  1281. Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
  1282. ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
  1283. Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行。"
  1284. ElseIf TypeOf InnerEx Is OutOfMemoryException Then
  1285. Return "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
  1286. ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
  1287. Return "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
  1288. ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then
  1289. Return "请尝试卸载中国移动云盘,然后再试。"
  1290. ElseIf OuterEx.IsNetworkRelated() Then
  1291. Return "你的网络环境不佳,请稍后再试,或使用 VPN 改善网络环境。"
  1292. Else
  1293. Return Nothing
  1294. End If
  1295. End Function
  1296. ''' <summary>
  1297. ''' 返回一个枚举对应的字符串。
  1298. ''' </summary>
  1299. ''' <param name="EnumData">一个已经实例化的枚举类型。</param>
  1300. Public Function GetStringFromEnum(EnumData As [Enum]) As String
  1301. Return [Enum].GetName(EnumData.GetType, EnumData)
  1302. End Function
  1303. ''' <summary>
  1304. ''' 将对象转换为枚举类型,支持数字或原文两种格式,若为空字符串或 Nothing 则返回 0。
  1305. ''' 若转换失败会抛出异常。
  1306. ''' </summary>
  1307. <Extension> Public Function ToEnum(Of T As Structure)(Value As Object) As T
  1308. If IsNumeric(Value) Then
  1309. Return CType(CInt(Value), Object)
  1310. ElseIf String.IsNullOrEmpty(Value?.ToString) Then
  1311. Return CType(0, Object)
  1312. Else
  1313. Return [Enum].Parse(GetType(T), Value.ToString(), True)
  1314. End If
  1315. End Function
  1316. ''' <summary>
  1317. ''' 将文件大小转化为适合的文本形式,如“1.28 M”。
  1318. ''' </summary>
  1319. ''' <param name="FileSize">以字节为单位的大小表示。</param>
  1320. Public Function FormatFileSize(FileSize As Long) As String
  1321. Dim IsNegative = FileSize < 0
  1322. If IsNegative Then FileSize *= -1
  1323. If FileSize < 1000 Then
  1324. 'B 级
  1325. Return If(IsNegative, "-", "") & FileSize & " B"
  1326. ElseIf FileSize < 1024 * 1000 Then
  1327. 'K 级
  1328. Dim RoundResult As String = Math.Round(FileSize / 1024)
  1329. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " K"
  1330. ElseIf FileSize < 1024 * 1024 * 1000 Then
  1331. 'M 级
  1332. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
  1333. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " M"
  1334. Else
  1335. 'G 级
  1336. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
  1337. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " G"
  1338. End If
  1339. End Function
  1340. ''' <summary>
  1341. ''' 获取 JSON 对象。
  1342. ''' </summary>
  1343. Public Function GetJson(Data As String) As JToken
  1344. Try
  1345. Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
  1346. Catch ex As Exception
  1347. Dim Length As Integer = If(Data, "").Length
  1348. Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex)
  1349. End Try
  1350. End Function
  1351. ''' <summary>
  1352. ''' 获取字符串哈希值。
  1353. ''' </summary>
  1354. Public Function GetHash(Str As String) As ULong
  1355. Dim Result As ULong = 5381
  1356. For Each v In Str
  1357. Result = (Result << 5) Xor Result Xor CType(AscW(v), ULong)
  1358. Next
  1359. Return Result Xor &HA98F501BC684032FUL
  1360. End Function
  1361. ''' <summary>
  1362. ''' 获取字符串 MD5。
  1363. ''' </summary>
  1364. Public Function GetStringMD5(Str As String) As String
  1365. Using h = MD5Cng.Create()
  1366. Dim hashedDataBytes = h.ComputeHash(Encoding.UTF8.GetBytes(Str))
  1367. Dim tmp As New StringBuilder(hashedDataBytes.Length * 2)
  1368. For Each i As Byte In hashedDataBytes
  1369. tmp.Append(i.ToString("x2"))
  1370. Next
  1371. Return tmp.ToString()
  1372. End Using
  1373. End Function
  1374. ''' <summary>
  1375. ''' 不会报错的 Val。
  1376. ''' 如果输入有误,返回 0。
  1377. ''' </summary>
  1378. Public Function Val(Str As Object) As Double
  1379. If Str Is Nothing Then Return 0
  1380. Try
  1381. Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
  1382. Catch
  1383. Return 0
  1384. End Try
  1385. End Function
  1386. '正则
  1387. ''' <summary>
  1388. ''' 搜索字符串中的所有正则匹配项。
  1389. ''' </summary>
  1390. <Extension> Public Function RegexSearch(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As List(Of String)
  1391. Try
  1392. RegexSearch = New List(Of String)
  1393. Dim RegexSearchRes = New Regex(pattern, options).Matches(str)
  1394. If RegexSearchRes Is Nothing Then Return RegexSearch
  1395. For Each item As Match In RegexSearchRes
  1396. RegexSearch.Add(item.Value)
  1397. Next
  1398. Catch ex As Exception
  1399. Log(ex, "正则匹配全部项出错")
  1400. Return New List(Of String)
  1401. End Try
  1402. End Function
  1403. ''' <summary>
  1404. ''' 获取字符串中的第一个正则匹配项,若无匹配则返回 Nothing。
  1405. ''' </summary>
  1406. <Extension> Public Function RegexSeek(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As String
  1407. Try
  1408. Dim Result = Regex.Match(str, pattern, options).Value
  1409. Return If(Result = "", Nothing, Result)
  1410. Catch ex As Exception
  1411. Log(ex, "正则匹配第一项出错")
  1412. Return Nothing
  1413. End Try
  1414. End Function
  1415. ''' <summary>
  1416. ''' 检查字符串是否匹配某正则模式。
  1417. ''' </summary>
  1418. <Extension> Public Function RegexCheck(str As String, pattern As String, Optional options As RegexOptions = RegexOptions.None) As Boolean
  1419. Try
  1420. Return Regex.IsMatch(str, pattern, options)
  1421. Catch ex As Exception
  1422. Log(ex, "正则检查出错")
  1423. Return False
  1424. End Try
  1425. End Function
  1426. ''' <summary>
  1427. ''' 进行正则替换。失败时会抛出异常。
  1428. ''' </summary>
  1429. <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As String, Optional options As RegexOptions = RegexOptions.None) As String
  1430. Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
  1431. End Function
  1432. ''' <summary>
  1433. ''' 对每个正则匹配分别进行替换。失败时会抛出异常。
  1434. ''' </summary>
  1435. <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As MatchEvaluator, Optional options As RegexOptions = RegexOptions.None) As String
  1436. Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
  1437. End Function
  1438. #End Region
  1439. #Region "搜索"
  1440. ''' <summary>
  1441. ''' 获取搜索文本的相似度。
  1442. ''' </summary>
  1443. ''' <param name="Source">被搜索的长内容。</param>
  1444. ''' <param name="Query">用户输入的搜索文本。</param>
  1445. Private Function SearchSimilarity(Source As String, Query As String) As Double
  1446. If String.IsNullOrEmpty(Source) OrElse String.IsNullOrEmpty(Query) Then Return 0
  1447. Dim qp As Integer = 0, lenSum As Double = 0
  1448. Dim str As New StringBuilder(Source.Length)
  1449. str.Append(Source.Lower().Replace(" ", ""))
  1450. Query = Query.Lower().Replace(" ", "")
  1451. Dim sourceLength As Integer = str.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
  1452. If queryLength = 0 Then Return 0
  1453. Do While qp < queryLength
  1454. '对 qp 作为开始位置计算
  1455. Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
  1456. Dim currentSourceLength As Integer = str.Length
  1457. Do While sp < currentSourceLength
  1458. Dim len As Integer = 0
  1459. While (qp + len) < queryLength AndAlso (sp + len) < currentSourceLength AndAlso str(sp + len) = Query(qp + len)
  1460. len += 1
  1461. End While
  1462. '存储 len
  1463. If len > lenMax Then
  1464. lenMax = len
  1465. spMax = sp
  1466. End If
  1467. '根据结果增加 sp
  1468. sp += If(len > 0, len, 1)
  1469. Loop
  1470. If lenMax > 0 Then
  1471. str.Remove(spMax, lenMax) '将源中的对应字段移除
  1472. '存储 lenSum
  1473. Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
  1474. IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
  1475. lenSum += IncWeight
  1476. End If
  1477. qp += If(lenMax > 0, lenMax, 1)
  1478. Loop
  1479. '计算结果:重复字段量 × 源长度影响比例
  1480. Return (lenSum / queryLength) * (3 / Math.Sqrt(sourceLength + 15)) * If(queryLength <= 2, 3 - queryLength, 1)
  1481. End Function
  1482. ''' <summary>
  1483. ''' 获取多段文本加权后的相似度。
  1484. ''' </summary>
  1485. Private Function SearchSimilarityWeighted(Source As List(Of SearchSource), Query As String) As Double
  1486. Dim TotalWeight As Double = 0
  1487. Dim Sum As Double = 0
  1488. For Each Pair In Source
  1489. If Pair.Aliases.Any Then
  1490. Sum += Pair.Aliases.Max(Function(a) SearchSimilarity(a, Query)) * Pair.Weight
  1491. End If
  1492. TotalWeight += Pair.Weight
  1493. Next
  1494. Return Sum / TotalWeight
  1495. End Function
  1496. ''' <summary>
  1497. ''' 用于搜索的项目。
  1498. ''' </summary>
  1499. Public Class SearchEntry(Of T)
  1500. ''' <summary>
  1501. ''' 该项目对应的源数据。
  1502. ''' </summary>
  1503. Public Item As T
  1504. ''' <summary>
  1505. ''' 该项目用于搜索的文本源。
  1506. ''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。
  1507. ''' </summary>
  1508. Public SearchSource As List(Of SearchSource)
  1509. ''' <summary>
  1510. ''' 相似度。
  1511. ''' </summary>
  1512. Public Similarity As Double
  1513. ''' <summary>
  1514. ''' 是否完全匹配。
  1515. ''' </summary>
  1516. Public AbsoluteRight As Boolean
  1517. Public Overrides Function ToString() As String
  1518. Return Math.Round(Similarity, 3) & " - " & Item.ToString()
  1519. End Function
  1520. End Class
  1521. ''' <summary>
  1522. ''' 单个用于搜索的文本源。
  1523. ''' </summary>
  1524. Public Class SearchSource
  1525. Public Aliases As String()
  1526. Public Weight As Double
  1527. Public Sub New(Aliases As String(), Optional Weight As Double = 1)
  1528. Me.Aliases = Aliases
  1529. Me.Weight = Weight
  1530. End Sub
  1531. Public Sub New(Text As String, Optional Weight As Double = 1)
  1532. Me.Aliases = {Text}
  1533. Me.Weight = Weight
  1534. End Sub
  1535. End Class
  1536. ''' <summary>
  1537. ''' 进行多段文本加权搜索,获取相似度较高的数项结果。
  1538. ''' 在搜索时,会对每个文本源单独加权,但单个文本源内的多个别名只取最高的一个的相似度。
  1539. ''' 这会修改 Entries 中每项的 Similarity 与 AbsoluteRight 字段。
  1540. ''' </summary>
  1541. ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
  1542. ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
  1543. 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))
  1544. '初始化
  1545. Dim ResultList As New List(Of SearchEntry(Of T))
  1546. If Not Entries.Any() Then Return ResultList
  1547. '进行搜索,获取相似信息
  1548. Dim QueryParts = Query.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
  1549. Dim Candidates As New List(Of SearchEntry(Of T))
  1550. For Each Entry In Entries
  1551. Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
  1552. Entry.AbsoluteRight =
  1553. QueryParts.All( '对于按空格分割的每一段
  1554. Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配,则标记为完全匹配项
  1555. Function(Source) Source.Aliases.Any(
  1556. Function([Alias]) [Alias].Replace(" ", "").ContainsIgnoreCase(QueryPart))))
  1557. If Entry.AbsoluteRight OrElse Entry.Similarity >= MinBlurSimilarity Then Candidates.Add(Entry)
  1558. Next
  1559. '按照相似度进行排序
  1560. Candidates = Candidates.SortByComparison(Function(Left, Right) If(Left.AbsoluteRight <> Right.AbsoluteRight, Left.AbsoluteRight, Left.Similarity > Right.Similarity))
  1561. '返回结果
  1562. Dim BlurCount As Integer = 0
  1563. For Each Entry In Candidates
  1564. If Entry.AbsoluteRight Then
  1565. ResultList.Add(Entry) '完全匹配,直接加入
  1566. Else
  1567. If BlurCount = MaxBlurCount Then Exit For
  1568. ResultList.Add(Entry)
  1569. BlurCount += 1 '模糊结果计数
  1570. End If
  1571. Next
  1572. Return ResultList
  1573. End Function
  1574. #End Region
  1575. #Region "系统"
  1576. ''' <summary>
  1577. ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
  1578. ''' </summary>
  1579. <Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
  1580. Dim DelayTask = Task.Delay(TimeoutMs)
  1581. If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
  1582. TokenSource.Cancel()
  1583. Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
  1584. End If
  1585. Return TargetTask.GetAwaiter().GetResult()
  1586. End Function
  1587. ''' <summary>
  1588. ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
  1589. ''' </summary>
  1590. <Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
  1591. Dim DelayTask = Task.Delay(TimeoutMs)
  1592. If Task.WhenAny(TargetTask, DelayTask).ConfigureAwait(False).GetAwaiter().GetResult() Is DelayTask Then
  1593. TokenSource.Cancel()
  1594. Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
  1595. End If
  1596. TargetTask.GetAwaiter().GetResult()
  1597. End Sub
  1598. ''' <summary>
  1599. ''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
  1600. ''' </summary>
  1601. Public PathPure As String = GetPureASCIIDir()
  1602. Private Function GetPureASCIIDir() As String
  1603. If (PathExeFolder & "PCL").IsAsciiOnly() Then
  1604. Return PathExeFolder & "PCL\"
  1605. ElseIf PathAppdata.IsAsciiOnly() Then
  1606. Return PathAppdata
  1607. ElseIf PathTemp.IsAsciiOnly() Then
  1608. Return PathTemp
  1609. Else
  1610. Return OsDrive & "ProgramData\PCL\"
  1611. End If
  1612. End Function
  1613. ''' <summary>
  1614. ''' 指示接取到这个异常的函数进行重试。
  1615. ''' </summary>
  1616. Public Class RestartException
  1617. Inherits Exception
  1618. End Class
  1619. ''' <summary>
  1620. ''' 指示用户手动取消了操作,或用户已知晓操作被取消的原因。
  1621. ''' </summary>
  1622. Public Class CancelledException
  1623. Inherits Exception
  1624. End Class
  1625. ''' <summary>
  1626. ''' 当前程序是否拥有管理员权限。
  1627. ''' </summary>
  1628. Public Function IsAdmin() As Boolean
  1629. Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
  1630. Dim principal As New WindowsPrincipal(id)
  1631. Return principal.IsInRole(WindowsBuiltInRole.Administrator)
  1632. End Function
  1633. ''' <summary>
  1634. ''' 以管理员权限运行当前程序,并等待程序运行结束。
  1635. ''' 返回程序的返回代码,如果运行失败将抛出异常。
  1636. ''' </summary>
  1637. Public Function RunAsAdmin(Argument As String) As Integer
  1638. Dim NewProcess = StartProcess(New ProcessStartInfo(PathExe) With {.Verb = "runas", .Arguments = Argument})
  1639. NewProcess.WaitForExit()
  1640. Return NewProcess.ExitCode
  1641. End Function
  1642. ''' <summary>
  1643. ''' 判断当前系统语言是否为中文。
  1644. ''' </summary>
  1645. Public Function IsSystemLanguageChinese() As Boolean
  1646. Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
  1647. End Function
  1648. ''' <summary>
  1649. ''' 判断对象是否为某个泛型类型的实例。
  1650. ''' </summary>
  1651. <Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
  1652. If obj Is Nothing Then Return False
  1653. Dim t = obj.GetType()
  1654. While t IsNot Nothing
  1655. If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
  1656. t = t.BaseType
  1657. End While
  1658. Return False
  1659. End Function
  1660. Private Uuid As Integer = 1
  1661. Private UuidLock As Object
  1662. ''' <summary>
  1663. ''' 获取一个全程序内不会重复的数字(伪 Uuid)。
  1664. ''' </summary>
  1665. Public Function GetUuid() As Integer
  1666. If UuidLock Is Nothing Then UuidLock = New Object
  1667. SyncLock UuidLock
  1668. Uuid += 1
  1669. Return Uuid
  1670. End SyncLock
  1671. End Function
  1672. ''' <summary>
  1673. ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
  1674. ''' </summary>
  1675. Public Function GetTimeNow() As String
  1676. Return Date.Now.ToString("HH':'mm':'ss'.'fff")
  1677. End Function
  1678. ''' <summary>
  1679. ''' 获取一个单调递增时间值(毫秒)。
  1680. ''' </summary>
  1681. Public Function GetTimeMs() As Long
  1682. Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
  1683. End Function
  1684. ''' <summary>
  1685. ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
  1686. ''' </summary>
  1687. Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
  1688. Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
  1689. If Span.TotalMilliseconds < 0 Then Span = -Span
  1690. Dim TotalMonthes = Math.Floor(Span.Days / 30)
  1691. If IsShortForm Then
  1692. If TotalMonthes >= 12 Then
  1693. '1+ 年,“3 年”
  1694. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  1695. ElseIf TotalMonthes >= 2 Then
  1696. '2~11 月,“5 个月”
  1697. GetTimeSpanString = TotalMonthes & " 个月"
  1698. ElseIf Span.TotalDays >= 2 Then
  1699. '2 天 ~ 2 月,“23 天”
  1700. GetTimeSpanString = Span.Days & " 天"
  1701. ElseIf Span.TotalHours >= 1 Then
  1702. '1 小时 ~ 2 天,“15 小时”
  1703. GetTimeSpanString = Span.Hours & " 小时"
  1704. ElseIf Span.TotalMinutes >= 1 Then
  1705. '1 分钟 ~ 1 小时,“49 分钟”
  1706. GetTimeSpanString = Span.Minutes & " 分钟"
  1707. ElseIf Span.TotalSeconds >= 1 Then
  1708. '1 秒 ~ 1 分钟,“23 秒”
  1709. GetTimeSpanString = Span.Seconds & " 秒"
  1710. Else
  1711. '不到 1 秒
  1712. GetTimeSpanString = "1 秒"
  1713. End If
  1714. Else
  1715. If TotalMonthes >= 61 Then
  1716. '5+ 年,“5 年”
  1717. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  1718. ElseIf TotalMonthes >= 12 Then
  1719. '12~60 月,“1 年 2 个月”
  1720. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
  1721. ElseIf TotalMonthes >= 4 Then
  1722. '4~11 月,“5 个月”
  1723. GetTimeSpanString = TotalMonthes & " 个月"
  1724. ElseIf TotalMonthes >= 1 Then
  1725. '1~4 月,“2 个月 13 天”
  1726. GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
  1727. ElseIf Span.TotalDays >= 4 Then
  1728. '4~30 天,“23 天”
  1729. GetTimeSpanString = Span.Days & " 天"
  1730. ElseIf Span.TotalDays >= 1 Then
  1731. '1~3 天,“2 天 20 小时”
  1732. GetTimeSpanString = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
  1733. ElseIf Span.TotalHours >= 10 Then
  1734. '10 小时 ~ 1 天,“15 小时”
  1735. GetTimeSpanString = Span.Hours & " 小时"
  1736. ElseIf Span.TotalHours >= 1 Then
  1737. '1~10 小时,“1 小时 20 分钟”
  1738. GetTimeSpanString = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
  1739. ElseIf Span.TotalMinutes >= 10 Then
  1740. '10 分钟 ~ 1 小时,“49 分钟”
  1741. GetTimeSpanString = Span.Minutes & " 分钟"
  1742. ElseIf Span.TotalMinutes >= 1 Then
  1743. '1~10 分钟,“9 分 23 秒”
  1744. GetTimeSpanString = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
  1745. ElseIf Span.TotalSeconds >= 1 Then
  1746. '1 秒 ~ 1 分钟,“23 秒”
  1747. GetTimeSpanString = Span.Seconds & " 秒"
  1748. Else
  1749. '不到 1 秒
  1750. GetTimeSpanString = "1 秒"
  1751. End If
  1752. End If
  1753. GetTimeSpanString += EndFix
  1754. End Function
  1755. ''' <summary>
  1756. ''' 获取十进制 Unix 时间戳。
  1757. ''' </summary>
  1758. Public Function GetUnixTimestamp() As Long
  1759. Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000
  1760. End Function
  1761. ''' <summary>
  1762. ''' 用于储存 RaiseByMouse 的 EventArgs。
  1763. ''' </summary>
  1764. Public NotInheritable Class RouteEventArgs
  1765. Inherits EventArgs
  1766. Public RaiseByMouse As Boolean
  1767. Public Handled As Boolean = False
  1768. Public Sub New(Optional RaiseByMouse As Boolean = False)
  1769. Me.RaiseByMouse = RaiseByMouse
  1770. End Sub
  1771. End Class
  1772. ''' <summary>
  1773. ''' 启动进程并返回进程实例,若失败则抛出异常。
  1774. ''' 会自动进行长路径处理。
  1775. ''' </summary>
  1776. Public Function StartProcess(FileName As String, Optional Arguments As String = "") As Process
  1777. Return StartProcess(New ProcessStartInfo With {.FileName = FileName, .Arguments = Arguments})
  1778. End Function
  1779. ''' <summary>
  1780. ''' 启动进程并返回进程实例,若失败则抛出异常。
  1781. ''' 会自动进行长路径处理。
  1782. ''' </summary>
  1783. Public Function StartProcess(StartInfo As ProcessStartInfo) As Process
  1784. StartInfo.FileName = FileUtils.ShortenPath(StartInfo.FileName)
  1785. If Not String.IsNullOrEmpty(StartInfo.WorkingDirectory) Then StartInfo.WorkingDirectory = FileUtils.ShortenPath(StartInfo.WorkingDirectory)
  1786. Log("[System] 启动进程:" & StartInfo.FileName & " " & StartInfo.Arguments)
  1787. Return Process.Start(StartInfo)
  1788. End Function
  1789. ''' <summary>
  1790. ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
  1791. ''' </summary>
  1792. ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
  1793. ''' <param name="Arguments">运行参数。</param>
  1794. ''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
  1795. Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
  1796. Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
  1797. Dim Info = New ProcessStartInfo With {
  1798. .Arguments = Arguments,
  1799. .FileName = FileUtils.ShortenPath(FileName),
  1800. .UseShellExecute = False,
  1801. .CreateNoWindow = True,
  1802. .RedirectStandardError = True,
  1803. .RedirectStandardOutput = True,
  1804. .WorkingDirectory = FileUtils.ShortenPath(If(WorkingDirectory, PathExeFolder.TrimEnd("\"c))),
  1805. .StandardErrorEncoding = Encoding,
  1806. .StandardOutputEncoding = Encoding
  1807. }
  1808. If WorkingDirectory IsNot Nothing Then
  1809. If Info.EnvironmentVariables.ContainsKey("appdata") Then
  1810. Info.EnvironmentVariables("appdata") = WorkingDirectory
  1811. Else
  1812. Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
  1813. End If
  1814. End If
  1815. If PrintLog Then Log("[System] 执行命令并等待返回结果:" & FileName & " " & Arguments)
  1816. Using Program As New Process With {.StartInfo = Info}
  1817. Program.Start()
  1818. Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
  1819. Program.WaitForExit(Timeout)
  1820. If Not Program.HasExited Then Program.Kill()
  1821. Return Result
  1822. End Using
  1823. End Function
  1824. ''' <summary>
  1825. ''' 在新的工作线程中执行代码。
  1826. ''' </summary>
  1827. Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
  1828. Dim th As New Thread(
  1829. Sub()
  1830. Try
  1831. Action()
  1832. Catch ex As ThreadInterruptedException
  1833. Log(Name & ":线程已中止")
  1834. Catch ex As Exception
  1835. Log(ex, Name & ":线程执行失败", NotifyLevel.MsgBoxAndFeedback)
  1836. End Try
  1837. End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
  1838. th.Start()
  1839. Return th
  1840. End Function
  1841. ''' <summary>
  1842. ''' 确保在 UI 线程中执行代码。
  1843. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  1844. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  1845. ''' </summary>
  1846. Public Function RunInUiWait(Of Output)(Action As Func(Of Output)) As Output
  1847. If RunInUi() Then
  1848. Return Action()
  1849. Else
  1850. Return Application.Current.Dispatcher.Invoke(Action)
  1851. End If
  1852. End Function
  1853. ''' <summary>
  1854. ''' 确保在 UI 线程中执行代码。
  1855. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  1856. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  1857. ''' </summary>
  1858. Public Sub RunInUiWait(Action As Action)
  1859. If RunInUi() Then
  1860. Action()
  1861. Else
  1862. Application.Current.Dispatcher.Invoke(Action)
  1863. End If
  1864. End Sub
  1865. ''' <summary>
  1866. ''' 确保在 UI 线程中执行代码,代码按触发顺序执行。
  1867. ''' 如果当前并非 UI 线程,也不阻断当前线程的执行。
  1868. ''' </summary>
  1869. Public Sub RunInUi(Action As Action, Optional ForceWaitUntilLoaded As Boolean = False)
  1870. If ForceWaitUntilLoaded Then
  1871. Application.Current.Dispatcher.InvokeAsync(Action, Threading.DispatcherPriority.Loaded)
  1872. ElseIf RunInUi() Then
  1873. Action()
  1874. Else
  1875. Application.Current.Dispatcher.InvokeAsync(Action)
  1876. End If
  1877. End Sub
  1878. ''' <summary>
  1879. ''' 确保在工作线程中执行代码。
  1880. ''' </summary>
  1881. Public Sub RunInThread(Action As Action)
  1882. If RunInUi() Then
  1883. RunInNewThread(Action, "Invoke " & GetUuid())
  1884. Else
  1885. Action()
  1886. End If
  1887. End Sub
  1888. ''' <summary>
  1889. ''' 按照既定的函数进行选择排序。
  1890. ''' 返回第一个对象是否应该排在前面(a > b)。
  1891. ''' </summary>
  1892. <Extension> Public Function SortByComparison(Of T)(List As IList(Of T), SortRule As Func(Of T, T, Boolean)) As List(Of T)
  1893. Dim NewList As New List(Of T)
  1894. While List.Any
  1895. Dim Highest = List(0)
  1896. For i = 1 To List.Count - 1
  1897. If SortRule(List(i), Highest) Then Highest = List(i)
  1898. Next
  1899. List.Remove(Highest)
  1900. NewList.Add(Highest)
  1901. End While
  1902. Return NewList
  1903. End Function
  1904. ''' <summary>
  1905. ''' 获取程序启动参数。
  1906. ''' </summary>
  1907. ''' <param name="Name">参数名。</param>
  1908. ''' <param name="DefaultValue">默认值。</param>
  1909. Public Function GetProgramArgument(Name As String, Optional DefaultValue As Object = "")
  1910. Dim AllArguments() As String = Command.Split(" ")
  1911. For i = 0 To AllArguments.Length - 1
  1912. If AllArguments(i) = "-" & Name Then
  1913. If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
  1914. Return AllArguments(i + 1)
  1915. End If
  1916. Next
  1917. Return DefaultValue
  1918. End Function
  1919. ''' <summary>
  1920. ''' 时间戳转化为日期。
  1921. ''' </summary>
  1922. Public Function GetDate(timeStamp As Integer) As Date
  1923. Dim dtStart As Date = TimeZone.CurrentTimeZone.ToLocalTime(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc))
  1924. Dim lTime As Long = (CLng(timeStamp) * 10000000)
  1925. Return dtStart.Add(New TimeSpan(lTime))
  1926. End Function
  1927. ''' <summary>
  1928. ''' 将 UTC 时间转化为当前时区的时间。
  1929. ''' </summary>
  1930. Public Function GetLocalTime(UtcDate As Date) As Date
  1931. Return DateTime.SpecifyKind(UtcDate, DateTimeKind.Utc).ToLocalTime
  1932. End Function
  1933. ''' <summary>
  1934. ''' 打开网页。
  1935. ''' </summary>
  1936. Public Sub OpenWebsite(Url As String)
  1937. Try
  1938. If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) AndAlso Not Url.StartsWithF("minecraft-preview://", True) Then
  1939. Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
  1940. End If
  1941. Log("[System] 正在打开网页:" & Url)
  1942. StartProcess(Url)
  1943. Catch ex As Exception
  1944. Log(ex, "无法打开网页(" & Url & ")")
  1945. ClipboardSet(Url, False)
  1946. MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf &
  1947. $"网址:{Url}", "无法打开网页")
  1948. End Try
  1949. End Sub
  1950. ''' <summary>
  1951. ''' 打开 explorer。
  1952. ''' 若不以 \ 结尾,则将视作文件路径,打开并选中此文件。
  1953. ''' </summary>
  1954. Public Sub OpenExplorer(Location As String)
  1955. Try
  1956. Location = Location.Replace("/", "\").Trim(" "c, """"c)
  1957. Log("[System] 正在打开资源管理器:" & Location)
  1958. If Location.EndsWithF("\") Then
  1959. StartProcess(Location)
  1960. Else
  1961. StartProcess("explorer", $"/select,""{Location}""")
  1962. End If
  1963. Catch ex As Exception
  1964. Log(ex, "打开资源管理器失败,请尝试关闭安全软件(如 360 安全卫士)", NotifyLevel.MsgBox)
  1965. End Try
  1966. End Sub
  1967. ''' <summary>
  1968. ''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
  1969. ''' </summary>
  1970. Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
  1971. RunInThread(
  1972. Sub()
  1973. Dim RetryCount As Integer = 0
  1974. Retry:
  1975. Try
  1976. RunInUi(
  1977. Sub()
  1978. My.Computer.Clipboard.Clear()
  1979. If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
  1980. End Sub)
  1981. Catch ex As Exception
  1982. RetryCount += 1
  1983. If RetryCount <= 5 Then
  1984. Thread.Sleep(20)
  1985. GoTo Retry
  1986. Else
  1987. Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", NotifyLevel.AllUsers)
  1988. End If
  1989. End Try
  1990. If ShowSuccessHint Then Hint("已成功复制!", HintType.Green)
  1991. End Sub)
  1992. End Sub
  1993. ''' <summary>
  1994. ''' 获取剪贴板文本。将在 UI 线程运行,且不会抛出异常。
  1995. ''' </summary>
  1996. Public Function ClipboardGetText() As String
  1997. Dim Result As String = Nothing
  1998. RunInUiWait(
  1999. Sub()
  2000. Try
  2001. If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
  2002. Catch ex As Exception
  2003. Log(ex, "获取剪贴板文本失败")
  2004. End Try
  2005. End Sub)
  2006. Return Result
  2007. End Function
  2008. ''' <summary>
  2009. ''' 以 Byte() 形式获取程序中的资源。
  2010. ''' </summary>
  2011. Public Function GetResources(ResourceName As String) As Byte()
  2012. Log("[System] 获取资源:" & ResourceName)
  2013. Return My.Resources.ResourceManager.GetObject(ResourceName)
  2014. End Function
  2015. #End Region
  2016. #Region "UI"
  2017. 'DPI 转换
  2018. Public ReadOnly DPI As Integer = System.Drawing.Graphics.FromHwnd(IntPtr.Zero).DpiX
  2019. ''' <summary>
  2020. ''' 将经过 DPI 缩放的 WPF 尺寸转化为实际的像素尺寸。
  2021. ''' </summary>
  2022. Public Function GetPixelSize(WPFSize As Double) As Double
  2023. Return WPFSize / 96 * DPI
  2024. End Function
  2025. ''' <summary>
  2026. ''' 将实际的像素尺寸转化为经过 DPI 缩放的 WPF 尺寸。
  2027. ''' </summary>
  2028. Public Function GetWPFSize(PixelSize As Double) As Double
  2029. Return PixelSize * 96 / DPI
  2030. End Function
  2031. ''' <summary>
  2032. ''' 将 XML 转换为对应 UI 对象。
  2033. ''' 注意:性能较差,不应大量使用。
  2034. ''' </summary>
  2035. Public Function GetObjectFromXML(Str As XElement)
  2036. Return GetObjectFromXML(Str.ToString)
  2037. End Function
  2038. ''' <summary>
  2039. ''' 将 XML 转换为对应 UI 对象。
  2040. ''' 注意:性能较差,不应大量使用。
  2041. ''' </summary>
  2042. Public Function GetObjectFromXML(Str As String) As Object
  2043. Str = Str. '兼容旧版自定义事件写法
  2044. Replace("EventType=""", "local:CustomEventService.EventType=""").
  2045. Replace("EventData=""", "local:CustomEventService.EventData=""").
  2046. Replace("EventType='", "local:CustomEventService.EventType='").
  2047. Replace("EventData='", "local:CustomEventService.EventData='").
  2048. Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
  2049. Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""").
  2050. Replace("Property='EventType'", "Property='local:CustomEventService.EventType'").
  2051. Replace("Property='EventData'", "Property='local:CustomEventService.EventData'")
  2052. Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
  2053. '类型检查
  2054. Using Reader As New XamlXmlReader(Stream)
  2055. While Reader.Read()
  2056. For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider), GetType(SettingService)}
  2057. If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 类型。")
  2058. If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 值。")
  2059. Next
  2060. For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
  2061. If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListMember} 成员。")
  2062. Next
  2063. End While
  2064. End Using
  2065. '实际的加载
  2066. Stream.Position = 0
  2067. Using Writer As New StreamWriter(Stream)
  2068. Writer.Write(Str)
  2069. Writer.Flush()
  2070. Stream.Position = 0
  2071. Return Markup.XamlReader.Load(Stream)
  2072. End Using
  2073. End Using
  2074. End Function
  2075. Private ReadOnly UiThreadId As Integer = Thread.CurrentThread.ManagedThreadId
  2076. ''' <summary>
  2077. ''' 当前线程是否为主线程。
  2078. ''' </summary>
  2079. Public Function RunInUi() As Boolean
  2080. Return Thread.CurrentThread.ManagedThreadId = UiThreadId
  2081. End Function
  2082. ''' <summary>
  2083. ''' 检查某个控件是否位于主窗口可视区域内,且控件本身可见。
  2084. ''' </summary>
  2085. <Extension> Public Function IsVisibleInForm(element As FrameworkElement) As Boolean
  2086. If Not element.IsVisible Then Return False
  2087. Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight))
  2088. Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight)
  2089. Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
  2090. End Function
  2091. ''' <summary>
  2092. ''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
  2093. ''' </summary>
  2094. <Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
  2095. Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
  2096. Return Control.DesiredSize.Width > Control.ActualWidth
  2097. End Function
  2098. ''' <summary>
  2099. ''' 获取文本在被渲染后的宽度。
  2100. ''' </summary>
  2101. Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
  2102. If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
  2103. Dim formattedText = New FormattedText(
  2104. text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
  2105. fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
  2106. Return formattedText.Width
  2107. End Function
  2108. ''' <summary>
  2109. ''' 将布尔值转换为 Visibility。True 转换为 Visible,False 转换为 Collapsed。
  2110. ''' </summary>
  2111. <Extension> Public Function ToVisibility(IsVisible As Boolean) As Visibility
  2112. Return If(IsVisible, Visibility.Visible, Visibility.Collapsed)
  2113. End Function
  2114. #End Region
  2115. #Region "Debug"
  2116. Public ReadOnly Property ModeDebug As Boolean
  2117. Get
  2118. Return Settings.Get("SystemDebugMode")
  2119. End Get
  2120. End Property
  2121. 'Log
  2122. Public Enum NotifyLevel
  2123. ''' <summary>
  2124. ''' 不提示,只记录日志。
  2125. ''' </summary>
  2126. Silent = 0
  2127. ''' <summary>
  2128. ''' 只在开发中版本弹出提示条。
  2129. ''' </summary>
  2130. DevelopOnly = 1
  2131. ''' <summary>
  2132. ''' 只在开发中版本或调试模式下弹出提示条。
  2133. ''' </summary>
  2134. DebugModeOnly = 2
  2135. ''' <summary>
  2136. ''' 对所有用户弹出提示条。
  2137. ''' </summary>
  2138. AllUsers = 3
  2139. ''' <summary>
  2140. ''' 弹出窗口,不要求提交反馈。
  2141. ''' </summary>
  2142. MsgBox = 4
  2143. ''' <summary>
  2144. ''' 弹出窗口,并要求提交反馈。
  2145. ''' </summary>
  2146. MsgBoxAndFeedback = 5
  2147. ''' <summary>
  2148. ''' 弹出 Windows 原生弹窗,并要求提交反馈。
  2149. ''' 可在无法保证 UI 能正常运行时使用此级别。
  2150. ''' </summary>
  2151. Critical = 6
  2152. End Enum
  2153. Private LogList As New StringBuilder
  2154. Private LogWritter As StreamWriter
  2155. Public Sub LogStart()
  2156. RunInNewThread(
  2157. Sub()
  2158. Dim IsInitSuccess As Boolean = True
  2159. Try
  2160. For i = 4 To 1 Step -1
  2161. If File.Exists(PathExeFolder & "PCL\Log" & i & ".txt") Then
  2162. If File.Exists(PathExeFolder & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(PathExeFolder & "PCL\Log" & (i + 1) & ".txt")
  2163. CopyFile(PathExeFolder & "PCL\Log" & i & ".txt", PathExeFolder & "PCL\Log" & (i + 1) & ".txt")
  2164. End If
  2165. Next
  2166. File.Create(PathExeFolder & "PCL\Log1.txt").Dispose()
  2167. Catch ex As IOException
  2168. IsInitSuccess = False
  2169. Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Red)
  2170. Log(ex, "日志初始化失败(疑似文件占用问题)")
  2171. Catch ex As Exception
  2172. IsInitSuccess = False
  2173. Log(ex, "日志初始化失败", NotifyLevel.AllUsers)
  2174. End Try
  2175. Try
  2176. LogWritter = New StreamWriter(PathExeFolder & "PCL\Log1.txt", True) With {.AutoFlush = True}
  2177. Catch ex As Exception
  2178. LogWritter = Nothing
  2179. Log(ex, "日志写入失败", NotifyLevel.AllUsers)
  2180. End Try
  2181. While True
  2182. If IsInitSuccess Then
  2183. LogFlush()
  2184. Else
  2185. LogList = New StringBuilder '清空 LogList 避免内存爆炸
  2186. End If
  2187. Thread.Sleep(50)
  2188. End While
  2189. End Sub, "Log Writer", ThreadPriority.Lowest)
  2190. End Sub
  2191. Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
  2192. Public Sub LogFlush()
  2193. On Error Resume Next
  2194. If LogWritter Is Nothing Then Return
  2195. Dim Log As String = Nothing
  2196. SyncLock LogFlushLock
  2197. If LogList.Length > 0 Then
  2198. Dim LogListCache As StringBuilder
  2199. LogListCache = LogList
  2200. LogList = New StringBuilder
  2201. Log = LogListCache.ToString
  2202. End If
  2203. End SyncLock
  2204. If Log IsNot Nothing Then
  2205. LogWritter.Write(Log)
  2206. End If
  2207. End Sub
  2208. Private ReadOnly LogListLock As New Object '防止日志乱码,只在调试模式下启用
  2209. Private IsCriticalErrorTriggered As Boolean = False
  2210. ''' <summary>
  2211. ''' 输出 Log。
  2212. ''' </summary>
  2213. ''' <param name="Title">如果要求弹窗,指定弹窗的标题。</param>
  2214. Public Sub Log(Text As String, Optional Level As NotifyLevel = NotifyLevel.Silent, Optional Title As String = "出现错误")
  2215. On Error Resume Next
  2216. '放在最后会导致无法显示极端错误下的弹窗(如无法写入日志文件)
  2217. '处理错误会导致再次调用 Log() 导致无限循环
  2218. '输出日志
  2219. Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
  2220. AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
  2221. If ModeDebug Then
  2222. SyncLock LogListLock
  2223. LogList.Append(AppendText)
  2224. End SyncLock
  2225. Else
  2226. LogList.Append(AppendText)
  2227. End If
  2228. If BuildType = BuildTypes.Debug Then Console.Write(AppendText)
  2229. If IsProgramEnded OrElse Level = NotifyLevel.Silent Then Return
  2230. '去除前缀
  2231. Text = Text.RegexReplace("\[[^\]]+?\] ", "")
  2232. '输出提示
  2233. Select Case Level
  2234. Case NotifyLevel.DevelopOnly
  2235. If BuildType = BuildTypes.Debug Then Hint("[开发者模式] " & Text, HintType.Blue, False)
  2236. Case NotifyLevel.DebugModeOnly
  2237. If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
  2238. Case NotifyLevel.AllUsers
  2239. Hint(Text, HintType.Red, False)
  2240. Case NotifyLevel.MsgBox
  2241. MyMsgBox(Text, Title, IsWarn:=True)
  2242. Case NotifyLevel.MsgBoxAndFeedback
  2243. If CanFeedback(False) Then
  2244. If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  2245. Else
  2246. MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  2247. End If
  2248. Case NotifyLevel.Critical
  2249. If IsCriticalErrorTriggered Then
  2250. FormMain.EndProgramForce(ProcessReturnValues.Exception)
  2251. Return
  2252. End If
  2253. IsCriticalErrorTriggered = True
  2254. If CanFeedback(False) Then
  2255. If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  2256. Else
  2257. MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  2258. End If
  2259. End Select
  2260. '上报
  2261. If Level >= NotifyLevel.AllUsers Then
  2262. Telemetry("PCL 错误",
  2263. "Level", GetStringFromEnum(Level),
  2264. "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
  2265. "Exception", FilterUserName(FilterAccessToken(Text, "*"), "*"))
  2266. End If
  2267. End Sub
  2268. ''' <summary>
  2269. ''' 输出错误信息。
  2270. ''' </summary>
  2271. ''' <param name="Desc">错误描述。会在处理时在末尾加入冒号。</param>
  2272. Public Sub Log(Ex As Exception, Desc As String, Optional Level As NotifyLevel = NotifyLevel.DebugModeOnly, Optional Title As String = "出现错误")
  2273. On Error Resume Next
  2274. If TypeOf Ex Is ThreadInterruptedException Then Return
  2275. '获取错误信息
  2276. Dim ExFull As String = $"{Desc}:{Ex.GetDetail()}"
  2277. '输出日志
  2278. Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
  2279. AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
  2280. If ModeDebug Then
  2281. SyncLock LogListLock
  2282. LogList.Append(AppendText)
  2283. End SyncLock
  2284. Else
  2285. LogList.Append(AppendText)
  2286. End If
  2287. If BuildType = BuildTypes.Debug Then Console.Write(AppendText)
  2288. If IsProgramEnded Then Return
  2289. '输出提示
  2290. Select Case Level
  2291. Case NotifyLevel.Silent
  2292. Case NotifyLevel.DevelopOnly
  2293. If BuildType = BuildTypes.Debug Then
  2294. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  2295. Hint("[开发者模式] " & ExLine, HintType.Blue, False)
  2296. End If
  2297. Case NotifyLevel.DebugModeOnly
  2298. If BuildType = BuildTypes.Debug OrElse ModeDebug Then
  2299. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  2300. Hint("[调试模式] " & ExLine, HintType.Blue, False)
  2301. End If
  2302. Case NotifyLevel.AllUsers
  2303. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  2304. Hint(ExLine, HintType.Red, False)
  2305. Case NotifyLevel.MsgBox
  2306. MyMsgBox(ExFull, Title, IsWarn:=True)
  2307. Case NotifyLevel.MsgBoxAndFeedback
  2308. If CanFeedback(False) Then
  2309. If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  2310. Else
  2311. MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  2312. End If
  2313. Case NotifyLevel.Critical
  2314. If IsCriticalErrorTriggered Then
  2315. FormMain.EndProgramForce(ProcessReturnValues.Exception)
  2316. Return
  2317. End If
  2318. IsCriticalErrorTriggered = True
  2319. If CanFeedback(False) Then
  2320. If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  2321. Else
  2322. MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  2323. End If
  2324. End Select
  2325. '上报
  2326. If Level >= NotifyLevel.AllUsers Then
  2327. Telemetry("PCL 异常",
  2328. "Level", GetStringFromEnum(Level),
  2329. "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
  2330. "Exception", FilterUserName(FilterAccessToken(ExFull, "*"), "*"))
  2331. End If
  2332. End Sub
  2333. '反馈
  2334. Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
  2335. On Error Resume Next
  2336. FeedbackInfo()
  2337. If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
  2338. OpenExplorer(PathExeFolder & "PCL\Log1.txt")
  2339. End If
  2340. OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
  2341. End Sub
  2342. Public Function CanFeedback(ShowHint As Boolean) As Boolean
  2343. If False.Equals(PageSetupSystem.IsLauncherNewest) Then
  2344. If ShowHint Then
  2345. If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
  2346. UpdateCheckByButton()
  2347. End If
  2348. End If
  2349. Return False
  2350. Else
  2351. Return True
  2352. End If
  2353. End Function
  2354. ''' <summary>
  2355. ''' 在日志中输出系统诊断信息。
  2356. ''' </summary>
  2357. Public Sub FeedbackInfo()
  2358. On Error Resume Next
  2359. Log("[System] 诊断信息:" & vbCrLf &
  2360. "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
  2361. "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
  2362. "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
  2363. "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
  2364. "文件位置:" & PathExeFolder)
  2365. End Sub
  2366. '遥测
  2367. Public Sub Telemetry([Event] As String, ParamArray Datas As String())
  2368. If BuildType = BuildTypes.Debug Then Return '开发版不上传遥测
  2369. If Not Settings.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
  2370. If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
  2371. RunInNewThread(
  2372. Sub()
  2373. Try
  2374. Log($"[System] 匿名数据上报:{[Event]}")
  2375. Dim Url As String = $"{ClsBaseUrl}&Event={EscapeUtils.UrlEscape([Event])}"
  2376. For i = 0 To Datas.Length - 1 Step 2
  2377. Url &= "&" & EscapeUtils.UrlEscape(Datas(i)) & "=" & EscapeUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbCrLf))
  2378. Next
  2379. NetRequestByClient(Url, MakeLog:=False)
  2380. Catch ex As Exception
  2381. Log(ex, "匿名数据上报失败")
  2382. End Try
  2383. End Sub, "Telemetry", ThreadPriority.Lowest)
  2384. End Sub
  2385. '获取当前的堆栈信息
  2386. Public Function GetStackTrace() As String
  2387. Return (New StackTrace).GetFrames().Skip(1).
  2388. Select(Function(f) f.GetMethod).
  2389. Select(Function(f) $"{f.Name}({f.GetParameters.Select(Function(p) p.ToString).Join(", ")}) - {f.Module}").
  2390. Join(vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf)
  2391. End Function
  2392. #End Region
  2393. #Region "随机"
  2394. Private ReadOnly Random As New Random
  2395. ''' <summary>
  2396. ''' 随机选择其一。
  2397. ''' </summary>
  2398. Public Function RandomOne(Of T)(objects As ICollection(Of T)) As T
  2399. Return objects(RandomInteger(0, objects.Count - 1))
  2400. End Function
  2401. ''' <summary>
  2402. ''' 取随机整数(包含)。
  2403. ''' </summary>
  2404. Public Function RandomInteger(min As Integer, max As Integer) As Integer
  2405. Return Math.Floor((max - min + 1) * Random.NextDouble) + min
  2406. End Function
  2407. ''' <summary>
  2408. ''' 将数组随机打乱。
  2409. ''' </summary>
  2410. <Extension> Public Iterator Function Shuffle(Of T)(Raw As IEnumerable(Of T)) As IEnumerable(Of T)
  2411. Dim RawCopy As New List(Of T)(Raw)
  2412. Do While RawCopy.Any
  2413. Dim i As Integer = RandomInteger(0, RawCopy.Count - 1)
  2414. Yield RawCopy(i)
  2415. RawCopy.RemoveAt(i)
  2416. Loop
  2417. End Function
  2418. #End Region
  2419. End Module
  2420. #Region "WPF"
  2421. ''' <summary>
  2422. ''' 对数据绑定进行加法运算,使用参数决定加数。
  2423. ''' </summary>
  2424. Public Class AdditionConverter
  2425. Implements IValueConverter
  2426. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  2427. If value Is Nothing Then Return 0
  2428. Dim before As Double
  2429. If Not Double.TryParse(value.ToString(), before) Then Return 0
  2430. Dim scale As Double = 1
  2431. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  2432. Return before + scale
  2433. End Function
  2434. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  2435. If value Is Nothing Then Return Binding.DoNothing
  2436. Dim before As Double
  2437. If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
  2438. Dim scale As Double = 1
  2439. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  2440. If scale = 0 Then Return Binding.DoNothing
  2441. Return before - scale
  2442. End Function
  2443. End Class
  2444. ''' <summary>
  2445. ''' 对数据绑定进行乘法运算,使用参数决定乘数。
  2446. ''' </summary>
  2447. Public Class MultiplicationConverter
  2448. Implements IValueConverter
  2449. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  2450. If value Is Nothing Then Return 0
  2451. Dim before As Double
  2452. If Not Double.TryParse(value.ToString(), before) Then Return 0
  2453. Dim scale As Double = 1
  2454. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  2455. Return before * scale
  2456. End Function
  2457. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  2458. If value Is Nothing Then Return Binding.DoNothing
  2459. Dim before As Double
  2460. If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
  2461. Dim scale As Double = 1
  2462. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  2463. If scale = 0 Then Return Binding.DoNothing
  2464. Return before / scale
  2465. End Function
  2466. End Class
  2467. ''' <summary>
  2468. ''' 将取反的 Boolean 绑定到 Visibility。
  2469. ''' </summary>
  2470. Public Class InverseBooleanToVisibilityConverter
  2471. Implements IValueConverter
  2472. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  2473. If value Is Nothing Then Return Visibility.Visible
  2474. Dim boolValue As Boolean
  2475. Return If(Boolean.TryParse(value.ToString(), boolValue), If(boolValue, Visibility.Collapsed, Visibility.Visible), Visibility.Visible)
  2476. End Function
  2477. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  2478. If value Is Nothing Then Return False
  2479. Return If(TypeOf value Is Visibility, value <> Visibility.Visible, False)
  2480. End Function
  2481. End Class
  2482. ''' <summary>
  2483. ''' 将 Boolean 取反。
  2484. ''' </summary>
  2485. Public Class InverseBooleanConverter
  2486. Implements IValueConverter
  2487. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  2488. If value Is Nothing Then Return False
  2489. Dim boolValue As Boolean
  2490. Return If(Boolean.TryParse(value.ToString(), boolValue), Not boolValue, False)
  2491. End Function
  2492. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  2493. If value Is Nothing Then Return False
  2494. Return If(Boolean.TryParse(value.ToString(), value), Not value, False)
  2495. End Function
  2496. End Class
  2497. #End Region