├── .gitattributes ├── .github └── workflows │ └── build.yaml ├── .gitignore ├── LICENSE ├── README.md ├── compatass.ico ├── compatass.lpi ├── compatass.lpr ├── compatass.res ├── cpu.pas ├── cpuinterface.pas ├── demo.png ├── unit1.lfm └── unit1.pas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /.github/workflows/build.yaml: -------------------------------------------------------------------------------- 1 | name: Build 2 | on: 3 | push: 4 | branches: 5 | - '**' 6 | 7 | jobs: 8 | build: 9 | name: Build Artifact 10 | runs-on: windows-2022 11 | 12 | steps: 13 | - uses: actions/checkout@v3 14 | with: 15 | fetch-depth: 1 # Let's save some space 16 | 17 | - name: Download Lazarus 18 | run: | 19 | curl --retry 5 -o lazarus-install.exe -L https://sourceforge.net/projects/lazarus/files/Lazarus%20Windows%2032%20bits/Lazarus%202.2.4/lazarus-2.2.4-fpc-3.2.2-win32.exe 20 | 21 | - name: Install Lazarus 22 | run: | 23 | Start-Process -Wait -NoNewWindow -FilePath lazarus-install.exe -ArgumentList "/VERYSILENT /DIR=C:\Lazarus /SP-" 24 | 25 | - name: Build with Lazarus 26 | run: | 27 | C:\Lazarus\lazbuild.exe --os=win32 --cpu=i386 --build-mode=Default --recursive compatass.lpi 28 | 29 | - name: Upload Artifact 30 | uses: actions/upload-artifact@v3 31 | with: 32 | name: Compatibility-Assistant-${{ github.sha }} 33 | path: "Greentea OS Compat v*.exe" 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | backup/ 2 | lib/ 3 | *.exe 4 | *.lps 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Greentea-OS-Compatibility-Assistant 2 | 3 | 🍑🍑🍑 4 | 5 | ### [Download now!](https://t.me/s/greenteaos_official?q=%23compatibility_assisant) 6 | 7 | ![Demo](https://raw.githubusercontent.com/PeyTy/Greentea-OS-Compatibility-Assistant/kawaii/demo.png) 8 | -------------------------------------------------------------------------------- /compatass.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GreenteaOS/Compatibility-Assistant/25dc697dc3858cc615ae638eb5008d1e53323c69/compatass.ico -------------------------------------------------------------------------------- /compatass.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | <Scaled Value="True"/> 13 | <ResourceType Value="res"/> 14 | <UseXPManifest Value="True"/> 15 | <XPManifest> 16 | <DpiAware Value="True"/> 17 | </XPManifest> 18 | <Icon Value="0"/> 19 | </General> 20 | <BuildModes Count="1"> 21 | <Item1 Name="Default" Default="True"/> 22 | </BuildModes> 23 | <PublishOptions> 24 | <Version Value="2"/> 25 | <UseFileFilters Value="True"/> 26 | </PublishOptions> 27 | <RunParams> 28 | <FormatVersion Value="2"/> 29 | </RunParams> 30 | <RequiredPackages Count="1"> 31 | <Item1> 32 | <PackageName Value="LCL"/> 33 | </Item1> 34 | </RequiredPackages> 35 | <Units Count="4"> 36 | <Unit0> 37 | <Filename Value="compatass.lpr"/> 38 | <IsPartOfProject Value="True"/> 39 | </Unit0> 40 | <Unit1> 41 | <Filename Value="unit1.pas"/> 42 | <IsPartOfProject Value="True"/> 43 | <ComponentName Value="Form1"/> 44 | <HasResources Value="True"/> 45 | <ResourceBaseClass Value="Form"/> 46 | <UnitName Value="Unit1"/> 47 | </Unit1> 48 | <Unit2> 49 | <Filename Value="cpuinterface.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | </Unit2> 52 | <Unit3> 53 | <Filename Value="cpu.pas"/> 54 | <IsPartOfProject Value="True"/> 55 | <UnitName Value="Cpu"/> 56 | </Unit3> 57 | </Units> 58 | </ProjectOptions> 59 | <CompilerOptions> 60 | <Version Value="11"/> 61 | <PathDelim Value="\"/> 62 | <Target> 63 | <Filename Value="Greentea OS Compat v1.3"/> 64 | </Target> 65 | <SearchPaths> 66 | <IncludeFiles Value="$(ProjOutDir)"/> 67 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 68 | </SearchPaths> 69 | <CodeGeneration> 70 | <SmartLinkUnit Value="True"/> 71 | <TargetCPU Value="i386"/> 72 | <Optimizations> 73 | <OptimizationLevel Value="3"/> 74 | </Optimizations> 75 | <SmallerCode Value="True"/> 76 | </CodeGeneration> 77 | <Linking> 78 | <Debugging> 79 | <GenerateDebugInfo Value="False"/> 80 | <DebugInfoType Value="dsDwarf3"/> 81 | </Debugging> 82 | <LinkSmart Value="True"/> 83 | <Options> 84 | <Win32> 85 | <GraphicApplication Value="True"/> 86 | </Win32> 87 | </Options> 88 | </Linking> 89 | </CompilerOptions> 90 | <Debugging> 91 | <Exceptions Count="3"> 92 | <Item1> 93 | <Name Value="EAbort"/> 94 | </Item1> 95 | <Item2> 96 | <Name Value="ECodetoolError"/> 97 | </Item2> 98 | <Item3> 99 | <Name Value="EFOpenError"/> 100 | </Item3> 101 | </Exceptions> 102 | </Debugging> 103 | </CONFIG> 104 | -------------------------------------------------------------------------------- /compatass.lpr: -------------------------------------------------------------------------------- 1 | program compatass; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, Unit1 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource:=True; 17 | Application.Title:='Greentea OS Compat'; 18 | Application.Scaled:=True; 19 | Application.Initialize; 20 | Application.CreateForm(TForm1, Form1); 21 | Application.Run; 22 | end. 23 | 24 | -------------------------------------------------------------------------------- /compatass.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GreenteaOS/Compatibility-Assistant/25dc697dc3858cc615ae638eb5008d1e53323c69/compatass.res -------------------------------------------------------------------------------- /cpu.pas: -------------------------------------------------------------------------------- 1 | {----------------------------------- 2 | Cpu Identifier implementation 3 | ------------------------------------- 4 | Class that encapsulate detail of 5 | getting processor vendor name, brand string 6 | supported features and etc 7 | ------------------------------------- 8 | (c) 2017 Zamrony P. Juhara <zamronypj@yahoo.com> 9 | http://github.com/zamronypj/cpuid 10 | -------------------------------------} 11 | unit Cpu; 12 | 13 | {$mode objfpc}{$H+} 14 | {$asmmode intel} 15 | 16 | interface 17 | 18 | uses 19 | Classes, SysUtils, CpuInterface; 20 | 21 | type 22 | 23 | TCPUIDResult = record 24 | eax : cardinal; 25 | ebx : cardinal; 26 | ecx : cardinal; 27 | edx : cardinal; 28 | end; 29 | 30 | TCPUVendorId = array [0..2] of cardinal; 31 | TCPUVendorIdStr = array [0..11] of ansichar; 32 | 33 | TCPUBasicInfo = record 34 | operation : cardinal; 35 | case boolean of 36 | true : (VendorIdStr : TCPUVendorIdStr); 37 | false: (VendorId : TCPUVendorId); 38 | end; 39 | 40 | TCPUBrand = array[0..15] of ansichar; 41 | TCPUBrandString = record 42 | case boolean of 43 | true : (res : TCPUIDResult); 44 | false : (brand : TCPUBrand); 45 | end; 46 | 47 | TCPUExtInfo = record 48 | extOperation : cardinal; 49 | moreOperation : cardinal; 50 | extOperationAvail : boolean; 51 | brandStringAvail : boolean; 52 | brandString : string; 53 | end; 54 | 55 | { TCpu } 56 | 57 | TCpuIdentifier = class(TInterfacedObject, ICpuIdentifier) 58 | private 59 | function cpuidExec(const operation : cardinal) : TCPUIDResult; 60 | function getCPUBasicInfo() : TCPUBasicInfo; 61 | function getCPUExtInfo() : TCPUExtInfo; 62 | public 63 | function cpuidSupported() : boolean; 64 | function processorName() : string; 65 | function vendorName() : string; 66 | function hasFeature(const feature : string) : boolean; 67 | function family() : byte; 68 | function model() : byte; 69 | function stepping() : byte; 70 | 71 | function maximumFrequency() : word; 72 | function baseFrequency() : word; 73 | function busReferenceFrequency() : word; 74 | end; 75 | 76 | implementation 77 | 78 | { TCpu } 79 | 80 | const 81 | CPUID_BIT = $200000; 82 | 83 | CPUID_OPR_BASIC_INFO = 0; 84 | CPUID_OPR_VERSION_FEATURE_INFO = 1; 85 | CPUID_OPR_PROC_FREQUENCY_INFO = $16; 86 | 87 | CPUID_OPR_EXTENDED_INFO = $80000000; 88 | CPUID_OPR_EXTENDED_INFO_MORE = $80000001; 89 | 90 | CPUID_OPR_BRAND_INFO_AVAIL = $80000004; 91 | CPUID_OPR_BRAND_INFO_0 = $80000002; 92 | CPUID_OPR_BRAND_INFO_1 = $80000003; 93 | CPUID_OPR_BRAND_INFO_2 = $80000004; 94 | 95 | {$IFDEF CPU32} 96 | {------------start 32 bit architecture code ----------} 97 | 98 | {** 99 | * Test availability of CPUID instruction 100 | * 101 | * @return boolean true if CPUID supported 102 | *} 103 | function TCpuIdentifier.cpuidSupported() : boolean; 104 | var supported:boolean; 105 | begin 106 | asm 107 | push eax 108 | push ecx 109 | 110 | //copy EFLAGS -> EAX 111 | pushfd 112 | pop eax 113 | 114 | //store original RFLAGS 115 | //so we can restore it later 116 | mov ecx, eax 117 | 118 | //change bit 21 119 | xor eax, CPUID_BIT 120 | 121 | //copy EAX -> EFLAGS 122 | push eax 123 | popfd 124 | 125 | //copy EFLAGS back to EAX 126 | pushfd 127 | pop eax 128 | 129 | //CPUID_BIT is reserved bit and cannot be changed 130 | //for 386 processor or lower 131 | //if we can change, it means we run on newer processor 132 | 133 | and eax, CPUID_BIT 134 | shr eax, 21 135 | mov supported, al 136 | 137 | //restore original EFLAGS 138 | push ecx 139 | popfd 140 | 141 | pop ecx 142 | pop eax 143 | end; 144 | result := supported; 145 | end; 146 | 147 | 148 | {* 149 | * Run CPUID instruction 150 | * @param cardinal operation store code for operation to be performed 151 | *} 152 | function TCpuIdentifier.cpuidExec(const operation : cardinal) : TCPUIDResult; 153 | var tmpEax, tmpEbx, tmpEcx, tmpEdx : cardinal; 154 | begin 155 | asm 156 | push eax 157 | push ebx 158 | push ecx 159 | push edx 160 | 161 | mov eax, operation 162 | cpuid 163 | 164 | mov tmpEax, eax 165 | mov tmpEbx, ebx 166 | mov tmpEcx, ecx 167 | mov tmpEdx, edx 168 | 169 | pop edx 170 | pop ecx 171 | pop ebx 172 | pop eax 173 | end; 174 | result.eax := tmpEax; 175 | result.ebx := tmpEbx; 176 | result.ecx := tmpEcx; 177 | result.edx := tmpEdx; 178 | end; 179 | {------------end 32 bit architecture code ----------} 180 | {$ENDIF} 181 | 182 | {$IFDEF CPU64} 183 | {------------start 64 bit architecture code ----------} 184 | 185 | {** 186 | * Test availability of CPUID instruction 187 | * 188 | * @return boolean true if CPUID supported 189 | *} 190 | function TCpuIdentifier.cpuidSupported() : boolean; 191 | var supported:boolean; 192 | begin 193 | asm 194 | push rax 195 | push rcx 196 | 197 | //copy RFLAGS -> RAX 198 | pushfq 199 | pop rax 200 | 201 | //store original RFLAGS 202 | //so we can restore it later 203 | mov rcx, rax 204 | 205 | //change bit 21 206 | xor rax, CPUID_BIT 207 | 208 | //copy RAX -> RFLAGS 209 | push rax 210 | popfq 211 | 212 | //copy RFLAGS back to EAX 213 | pushfq 214 | pop rax 215 | 216 | //CPUID_BIT is reserved bit and cannot be changed 217 | //for 386 processor or lower 218 | //if we can change, it means we run on newer processor 219 | 220 | and rax, CPUID_BIT 221 | shr rax, 21 222 | mov supported, al 223 | 224 | //restore original RFLAGS 225 | push rcx 226 | popfq 227 | 228 | pop rcx 229 | pop rax 230 | end; 231 | result := supported; 232 | end; 233 | 234 | 235 | {* 236 | * Run CPUID instruction 237 | * @param cardinal operation store code for operation to be performed 238 | *} 239 | function TCpuIdentifier.cpuidExec(const operation : cardinal) : TCPUIDResult; 240 | var tmpEax, tmpEbx, tmpEcx, tmpEdx : cardinal; 241 | begin 242 | asm 243 | push rax 244 | push rbx 245 | push rcx 246 | push rdx 247 | 248 | mov eax, operation 249 | cpuid 250 | 251 | mov tmpEax, eax 252 | mov tmpEbx, ebx 253 | mov tmpEcx, ecx 254 | mov tmpEdx, edx 255 | 256 | pop rdx 257 | pop rcx 258 | pop rbx 259 | pop rax 260 | end; 261 | result.eax := tmpEax; 262 | result.ebx := tmpEbx; 263 | result.ecx := tmpEcx; 264 | result.edx := tmpEdx; 265 | end; 266 | {------------end 64 bit architecture code ----------} 267 | {$ENDIF} 268 | 269 | function TCpuIdentifier.getCPUBasicInfo() : TCPUBasicInfo; 270 | var res:TCPUIDResult; 271 | begin 272 | result := Default(TCPUBasicInfo); 273 | if not cpuidSupported() then 274 | begin 275 | exit; 276 | end; 277 | 278 | res := cpuidExec(CPUID_OPR_BASIC_INFO); 279 | result.operation := res.eax; 280 | result.VendorId[0] := res.ebx; 281 | result.VendorId[1] := res.edx; 282 | result.VendorId[2] := res.ecx; 283 | end; 284 | 285 | function TCpuIdentifier.getCPUExtInfo() : TCPUExtInfo; 286 | var res:TCPUIDResult; 287 | br:TCPUBrandString; 288 | begin 289 | result := Default(TCPUExtInfo); 290 | if not cpuidSupported() then 291 | begin 292 | exit; 293 | end; 294 | 295 | res := cpuidExec(CPUID_OPR_EXTENDED_INFO_MORE); 296 | result.moreOperation := res.ecx; 297 | 298 | res := cpuidExec(CPUID_OPR_EXTENDED_INFO); 299 | result.extOperation := res.eax; 300 | result.extOperationAvail := (res.eax > CPUID_OPR_EXTENDED_INFO); 301 | result.brandStringAvail:=(res.eax >= CPUID_OPR_BRAND_INFO_AVAIL); 302 | result.brandString:=''; 303 | if result.brandStringAvail then 304 | begin 305 | br.res := cpuidExec(CPUID_OPR_BRAND_INFO_0); 306 | result.brandString := result.brandString + br.brand; 307 | br.res := cpuidExec(CPUID_OPR_BRAND_INFO_1); 308 | result.brandString := result.brandString + br.brand; 309 | br.res := cpuidExec(CPUID_OPR_BRAND_INFO_2); 310 | result.brandString := result.brandString + br.brand; 311 | end; 312 | end; 313 | 314 | function TCpuIdentifier.processorName() : string; 315 | var cpuExtInfo : TCPUExtInfo; 316 | begin 317 | cpuExtInfo := getCPUExtInfo(); 318 | result := cpuExtInfo.brandString; 319 | end; 320 | 321 | function TCpuIdentifier.vendorName() : string; 322 | var basicInfo : TCPUBasicInfo; 323 | begin 324 | basicInfo := getCPUBasicInfo(); 325 | result := basicInfo.VendorIdStr; 326 | end; 327 | 328 | const 329 | CPUID_VERSION_EXTFAMILY_BIT = $f00000; 330 | CPUID_VERSION_EXTMODEL_BIT = $0f0000; 331 | CPUID_VERSION_PROCTYPE_BIT = $003000; 332 | CPUID_VERSION_FAMILY_BIT = $000f00; 333 | CPUID_VERSION_MODEL_BIT = $0000f0; 334 | CPUID_VERSION_STEPPING_BIT = $00000f; 335 | 336 | function TCpuIdentifier.family() : byte; 337 | var res:TCPUIDResult; 338 | familyValue, extFamilyValue : byte; 339 | begin 340 | res := cpuidExec(CPUID_OPR_VERSION_FEATURE_INFO); 341 | familyValue := (res.eax and CPUID_VERSION_FAMILY_BIT) shr 8; 342 | result := familyValue; 343 | if (familyValue = $0f) then 344 | begin 345 | extFamilyValue := (res.eax and CPUID_VERSION_EXTFAMILY_BIT) shr 20; 346 | result := extFamilyValue + familyValue; 347 | end; 348 | end; 349 | 350 | function TCpuIdentifier.model(): byte; 351 | var res:TCPUIDResult; 352 | modelValue, familyValue, extModelValue : byte; 353 | begin 354 | res := cpuidExec(CPUID_OPR_VERSION_FEATURE_INFO); 355 | modelValue := (res.eax and CPUID_VERSION_MODEL_BIT) shr 4; 356 | familyValue := (res.eax and CPUID_VERSION_FAMILY_BIT) shr 8; 357 | result := modelValue; 358 | if ((familyValue = $06) or (familyValue = $0f)) then 359 | begin 360 | extModelValue := (res.eax and CPUID_VERSION_EXTMODEL_BIT) shr 16; 361 | result := (extModelValue shl 4) + modelValue; 362 | end; 363 | end; 364 | 365 | function TCpuIdentifier.stepping(): byte; 366 | var res:TCPUIDResult; 367 | begin 368 | res := cpuidExec(CPUID_OPR_VERSION_FEATURE_INFO); 369 | result := res.eax and CPUID_VERSION_STEPPING_BIT; 370 | end; 371 | 372 | function TCpuIdentifier.maximumFrequency() : word; 373 | var res:TCPUIDResult; 374 | begin 375 | res := cpuidExec(CPUID_OPR_PROC_FREQUENCY_INFO); 376 | result := res.ebx and $ff; 377 | end; 378 | 379 | function TCpuIdentifier.baseFrequency() : word; 380 | var res:TCPUIDResult; 381 | begin 382 | res := cpuidExec(CPUID_OPR_PROC_FREQUENCY_INFO); 383 | result := res.eax and $ff; 384 | end; 385 | 386 | function TCpuIdentifier.busReferenceFrequency() : word; 387 | var res:TCPUIDResult; 388 | begin 389 | res := cpuidExec(CPUID_OPR_PROC_FREQUENCY_INFO); 390 | result := res.ecx and $ff; 391 | end; 392 | 393 | function TCpuIdentifier.hasFeature(const feature: string): boolean; 394 | var res:TCPUIDResult; 395 | begin 396 | result := false; 397 | res := cpuidExec(CPUID_OPR_VERSION_FEATURE_INFO); 398 | case feature of 399 | 'SSE3' : result := ((res.ecx and $1) = $1); 400 | 'PCLMULQDQ' : result := ((res.ecx and $2) = $2); 401 | 'DTES64' : result := ((res.ecx and $4) = $4); 402 | 'MONITOR' : result := ((res.ecx and $8) = $8); 403 | 'DS-CPL' : result := ((res.ecx and $10) = $10); 404 | 'VMX' : result := ((res.ecx and $20) = $20); 405 | 'SMX' : result := ((res.ecx and $40) = $40); 406 | 'EIST' : result := ((res.ecx and $80) = $80); 407 | 'TM2' : result := ((res.ecx and $100) = $100); 408 | 'SSSE3' : result := ((res.ecx and $200) = $200); 409 | 'CNXT-ID' : result := ((res.ecx and $400) = $400); 410 | 'SDBG' : result := ((res.ecx and $800) = $800); 411 | 'FMA' : result := ((res.ecx and $1000) = $1000); 412 | 'CMPXCHG16B' : result := ((res.ecx and $2000) = $2000); 413 | 'xTPR' : result := ((res.ecx and $4000) = $4000); 414 | 'PDCM' : result := ((res.ecx and $8000) = $8000); 415 | //'reserved' : result := ((res.ecx and $10000) = $10000); 416 | 'PCID' : result := ((res.ecx and $20000) = $20000); 417 | 'DCA' : result := ((res.ecx and $40000) = $40000); 418 | 'SSE4_1' : result := ((res.ecx and $80000) = $80000); 419 | 'SSE4_2' : result := ((res.ecx and $100000) = $100000); 420 | 'x2APIC' : result := ((res.ecx and $200000) = $200000); 421 | 'MOVBE' : result := ((res.ecx and $400000) = $400000); 422 | 'POPCNT' : result := ((res.ecx and $800000) = $800000); 423 | 'TSC-DEADLINE' : result := ((res.ecx and $1000000) = $1000000); 424 | 'AES' : result := ((res.ecx and $2000000) = $2000000); 425 | 'XSAVE' : result := ((res.ecx and $4000000) = $4000000); 426 | 'OSXSAVE' : result := ((res.ecx and $8000000) = $8000000); 427 | 'AVX' : result := ((res.ecx and $10000000) = $10000000); 428 | 'F16C' : result := ((res.ecx and $20000000) = $20000000); 429 | 'RDRAND' : result := ((res.ecx and $40000000) = $40000000); 430 | //'notused' : result := ((res.ecx and $80000000) = $80000000); 431 | 432 | 'FPU' : result := ((res.edx and $1) = $1); 433 | 'VME' : result := ((res.edx and $2) = $2); 434 | 'DE' : result := ((res.edx and $4) = $4); 435 | 'PSE' : result := ((res.edx and $8) = $8); 436 | 'TSC' : result := ((res.edx and $10) = $10); 437 | 'MSR' : result := ((res.edx and $20) = $20); 438 | 'PAE' : result := ((res.edx and $40) = $40); 439 | 'MCE' : result := ((res.edx and $80) = $80); 440 | 'CX8' : result := ((res.edx and $100) = $100); 441 | 'APIC' : result := ((res.edx and $200) = $200); 442 | //'reserved' : result := ((res.edx and $400) = $400); 443 | 'SEP' : result := ((res.edx and $800) = $800); 444 | 'MTRR' : result := ((res.edx and $1000) = $1000); 445 | 'PGE' : result := ((res.edx and $2000) = $2000); 446 | 'MCA' : result := ((res.edx and $4000) = $4000); 447 | 'CMOV' : result := ((res.edx and $8000) = $8000); 448 | 'PAT' : result := ((res.edx and $10000) = $10000); 449 | 'PSE-36' : result := ((res.edx and $20000) = $20000); 450 | 'PSN' : result := ((res.edx and $40000) = $40000); 451 | 'CLFSH' : result := ((res.edx and $80000) = $80000); 452 | //'reserved' : result := ((res.edx and $100000) = $100000); 453 | 'DS' : result := ((res.edx and $200000) = $200000); 454 | 'ACPI' : result := ((res.edx and $400000) = $400000); 455 | 'MMX' : result := ((res.edx and $800000) = $800000); 456 | 'FXSR' : result := ((res.edx and $1000000) = $1000000); 457 | 'SSE' : result := ((res.edx and $2000000) = $2000000); 458 | 'SSE2' : result := ((res.edx and $4000000) = $4000000); 459 | 'SS' : result := ((res.edx and $8000000) = $8000000); 460 | 'HTT' : result := ((res.edx and $10000000) = $10000000); 461 | 'TM' : result := ((res.edx and $20000000) = $20000000); 462 | //'reserved' : result := ((res.edx and $40000000) = $40000000); 463 | 'PBE' : result := ((res.edx and $80000000) = $80000000); 464 | end; 465 | 466 | res := cpuidExec(CPUID_OPR_EXTENDED_INFO_MORE); 467 | case feature of 468 | // ECX 469 | 'SAHF' : result := ((res.ecx and $1) = $1); 470 | 'PREFETCHW' : result := ((res.ecx and $100) = $100); 471 | 472 | // EDX 473 | 'NX' : result := ((res.edx and $100000) = $100000); 474 | 'PDPE1GB' : result := ((res.edx and $4000000) = $4000000); 475 | end; 476 | end; 477 | 478 | end. 479 | 480 | -------------------------------------------------------------------------------- /cpuinterface.pas: -------------------------------------------------------------------------------- 1 | {----------------------------------- 2 | Cpu Identifier interface declaration 3 | ------------------------------------- 4 | Interface that encapsulate detail of 5 | getting processor vendor name, brand string 6 | supported features and etc 7 | ------------------------------------- 8 | (c) 2017 Zamrony P. Juhara <zamronypj@yahoo.com> 9 | http://github.com/zamronypj/cpuid 10 | -------------------------------------} 11 | unit CpuInterface; 12 | 13 | {$mode objfpc}{$H+} 14 | 15 | interface 16 | 17 | uses 18 | Classes, SysUtils; 19 | 20 | type 21 | 22 | ICpuIdentifier = interface 23 | function cpuidSupported() : boolean; 24 | function vendorName() : string; 25 | function processorName() : string; 26 | function family() : byte; 27 | function model() : byte; 28 | function stepping() : byte; 29 | function hasFeature(const feature : string) : boolean; 30 | 31 | function maximumFrequency() : word; 32 | function baseFrequency() : word; 33 | function busReferenceFrequency() : word; 34 | end; 35 | 36 | implementation 37 | 38 | end. 39 | 40 | -------------------------------------------------------------------------------- /demo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GreenteaOS/Compatibility-Assistant/25dc697dc3858cc615ae638eb5008d1e53323c69/demo.png -------------------------------------------------------------------------------- /unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 321 3 | Height = 354 4 | Top = 167 5 | Width = 529 6 | BorderIcons = [biSystemMenu, biMinimize] 7 | BorderStyle = bsSingle 8 | Caption = 'Greentea OS Compatibility Assistant' 9 | ClientHeight = 354 10 | ClientWidth = 529 11 | Color = clWhite 12 | DesignTimePPI = 120 13 | Position = poScreenCenter 14 | LCLVersion = '2.2.4.0' 15 | object Button1: TButton 16 | Left = 144 17 | Height = 48 18 | Hint = 'This will take just a second' 19 | Top = 200 20 | Width = 240 21 | Caption = 'Test compatibility now!' 22 | OnClick = Button1Click 23 | ParentShowHint = False 24 | ShowHint = True 25 | TabOrder = 0 26 | end 27 | object Label1: TLabel 28 | Left = 8 29 | Height = 20 30 | Top = 48 31 | Width = 512 32 | Alignment = taCenter 33 | AutoSize = False 34 | Caption = '...' 35 | ParentColor = False 36 | end 37 | object Label2: TLabel 38 | Left = 8 39 | Height = 20 40 | Top = 72 41 | Width = 512 42 | Alignment = taCenter 43 | AutoSize = False 44 | Caption = '...' 45 | ParentColor = False 46 | end 47 | object Button2: TButton 48 | Left = 144 49 | Height = 31 50 | Top = 256 51 | Width = 240 52 | Caption = 'Copy report to clipboard' 53 | Enabled = False 54 | OnClick = Button2Click 55 | TabOrder = 1 56 | end 57 | object Image1: TImage 58 | Cursor = crHandPoint 59 | Left = 472 60 | Height = 53 61 | Hint = 'https://greenteaos.github.io' 62 | Top = 301 63 | Width = 57 64 | OnClick = Image1Click 65 | ParentShowHint = False 66 | Picture.Data = { 67 | 1754506F727461626C654E6574776F726B47726170686963DC06000089504E47 68 | 0D0A1A0A0000000D49484452000000300000003008060000005702F987000006 69 | A3494441546881ED986B705D5515C77F6B9F93B479D492A436ADDA16B0080ABE 70 | 26A25310CA046410472A8FA25345666887A44988BD7954FC76BFA16D12C4706F 71 | 9202A3D39932401947333AF29216D0119082635B886DB10F0ACD8350DBD034BD 72 | F79EBDFC907B437273CE3D6DA5ED8C73FFDFEE5E6BAFFDFFAFBDF6DAFB5CC823 73 | 8F3CF2C8E37F41B7365ED4A3CD73CE358FD385AB147E5591D2B8B6EE4E217BE7 74 | B1F7D0EDB2D93BD7C44E16D2AD2D4B809B33038A0E28BADBE0BC251CD957231B 75 | 92E7905F28E47E5D735E1105CDA0337CCC83E0BD5980FB8F95B2EEBDB34F2F1C 76 | 0210D7E65506F99CC218E86141E64F7652C45378DBE0FDBD9FD77746656BEADC 77 | D01DC783FAB30A97B10BC014CBF840CB12F7A332FA97C51E3598CBFD265BE837 78 | F0B77EF66F8BCAE6C4D9201CD5A85BC9D86704EF12451703F3040A8197D23B70 79 | 6F99906A4E0FE2A1BD2E4E8162BF1D1454D10183D952C3FA3710F44C108F69D3 80 | 02C17CC9209F079D9B65B609CC8392F9D5A36BEF56ECE27172243CF421072D07 81 | B95D102768118BFEDBC29F1AA47DFFC741BA47EF2E4EF2892FBA6815C8F9936D 82 | 0AA3801198A9E8A101DA1F9810D0A5AD570ABA6C92F3B1E3789D33A0DCC1BDD3 83 | FF904F20A5E80B151C78EE745B705CEF2D3378DF50B44A60B68F4BBFA243C017 84 | C6132ACFD7CAFAA74CC6EA31DAA7E844CB14289989A91DC5396449FD5A2157BD 85 | BB825C3BCCA2551D1A293F15E28FE8DA59DDDA7AA390FA0968B51F7945F62A76 86 | 0BC885E96AB02748BC093021A04162C302EF4C9E6890F36641CD2087DFF3B01B 87 | 2DE4EC3E029F2DC6A98969D38230E2CB75B913D7D6AB12D846D06B048AFDFC14 88 | DDAE388F2966A940497A6CE8306507A70800B0989D3E31E6553267D5FB74EC11 89 | 7814B021DCCA0CE6AE5C227AF4A70BAFE3FC5A837E37A05C32F8EB00ED9B04EF 90 | 66039FFA4894F445256AA7094831D6E797658185F369BE63B5B4EDB0D8DF8508 91 | 40A0C4607EFC2BBDE793D9B6B846965A52358A2ECA15C3C20BB5D2F6FBB9B4FC 92 | 40D04BA6C64F4D247A8A8046E91C32E841BF808A5CDAADAD37D449C7CB8A7DF1 93 | 2444CC2EA47045549717C2782F8F69D3F70DCE770429C84DDEFEA54EDAFED8AD 94 | 2DCB0C7C254BD85005EF4E94BAF199EC57461919D55DDA72D96AE9F883457785 95 | 8950CC824A165D11D56BDCB98CDCE560AAC2E678E8AB75D2D11BD3C80DC095D9 96 | 76037D933B9D8F80993B14C9F580BBED618D943B8C3CAA70248C1068D51CBE76 97 | 9B412E0EF544B7D74BFB93316DBAC2C1A9F6F3B17853123C4D4083DC37ACD8C0 98 | 4B49A03885F9610D1B8E7BD8CD041C6A0B22684231452E520584DC0FF2CE00ED 99 | 9B621A59EC606E0A88393CC8EC033905A4B12D64B1053122DF6A908E5D165EF2 100 | F330A0161D156C890D7969288C08666339F7940A6645102F037D5189A6B2C6A6 101 | 6390E19D61E56170AEEED296B983BCF6347038CB2C0A630EE208C635E4546005 102 | 79AC467E71A490C21F19A434C83109FF9CCEC30751F9CD98C08E5C02040A15FD 103 | 5E54B6A652F07C96590D9CB0683168CEF42BBAA556D6EF8E6BD34DD96F9FAC15 104 | 072BD97F207B34A8844860B61172691964719746BEDE206DAF287A88F109A248 105 | 5251473081F1D3F4F7AD96F6A7E3BAF66283F9664E4FEC76BF7756E0028DB2EE 106 | 2021BB300EE7C698D6952649F4A645019A045390AB72144D26486C7E42973B82 107 | B72CD031EDEB51F89A9F2D6786C6483E3BF981E707816287925B1AA5F36DD037 108 | D207D6B368013914086C6B94CEA1F75978BD2039FF1551644F83DC377CCA02D6 109 | C8030316EBDB65B296B82CAECD550912BF35E8C8384191206F8B1CF738FE4C8F 110 | AE996F90ABC2E30777C5901A0597637F16CC9E303F815B84A20A8BF3B820922B 111 | B0A05BEA25FEA1C5BD15704342F73B1C7D2BC8182AA04636248F6237294CEB00 112 | 534949818B5DE9E00D7BF0B2A2413BD0BF5ADAB6C635B2546061D8FA82F76CAE 113 | BF7602B7391B31AD2B1566DE693021AF48FD0FD857C1A9363ED955DCB8C7C888 114 | 435124F30D1E1C4B76D5C9FA8773F984EE4006F512FF70900F1E51E495DC014D 115 | 99E05C6D108FAC0429F6C5017E7EC050744718798551417BC3789DF40E4CC643 116 | DA72411296085C94F94ACAC08218482A6658B0F34877220F7DD76524EE316B85 117 | 412E0D219FF0B01B1BA423F4C57B5A023288695DA9833BDFE25628E20A46C04B 118 | 9EC0F61733C35A52F58288229EA0BD8A5E28C897C3C85B529BEAE5978107F763 119 | 13108698B65EEFA0D7A5898D067DF766A0E80716FB64BDDC1FDAF53238A30200 120 | BA75EDB58A56CBF8C5E60B856302AF1760B6AE947523A712FF8C0B00E8D2C8A7 121 | 0DE6728B541AC455AC0A4ECAA2C38ADD9722B1BB513A8F9E0D2E79E491471E79 122 | FC7FE1BFA5DAAEBD88D905A50000000049454E44AE426082 123 | } 124 | ShowHint = True 125 | end 126 | object Label3: TLabel 127 | Left = 0 128 | Height = 20 129 | Top = 308 130 | Width = 453 131 | Caption = ' Greentea OS Compatibility Assistant is a Free Open Source Software' 132 | Font.Color = clGray 133 | ParentColor = False 134 | ParentFont = False 135 | end 136 | object Label4: TLabel 137 | Left = 8 138 | Height = 20 139 | Top = 96 140 | Width = 512 141 | Alignment = taCenter 142 | AutoSize = False 143 | Caption = '...' 144 | ParentColor = False 145 | end 146 | object Label5: TLabel 147 | Left = 0 148 | Height = 20 149 | Top = 331 150 | Width = 216 151 | Caption = ' GNU General Public License v3.0' 152 | Font.Color = clGray 153 | ParentColor = False 154 | ParentFont = False 155 | end 156 | object Label6: TLabel 157 | Left = 152 158 | Height = 88 159 | Top = 320 160 | Width = 512 161 | Alignment = taCenter 162 | AutoSize = False 163 | Caption = '...' 164 | Enabled = False 165 | ParentColor = False 166 | Visible = False 167 | WordWrap = True 168 | OnClick = Label6Click 169 | end 170 | object Label7: TLabel 171 | Left = 8 172 | Height = 20 173 | Hint = 'Also checks some CPUID' 174 | Top = 24 175 | Width = 512 176 | Alignment = taCenter 177 | AutoSize = False 178 | Caption = '...' 179 | ParentColor = False 180 | ParentShowHint = False 181 | ShowHint = True 182 | end 183 | object LabelSSE3: TLabel 184 | Left = 8 185 | Height = 20 186 | Top = 120 187 | Width = 102 188 | Alignment = taCenter 189 | AutoSize = False 190 | Caption = '...' 191 | ParentColor = False 192 | end 193 | object LabelPOPCNT: TLabel 194 | Left = 112 195 | Height = 20 196 | Top = 120 197 | Width = 100 198 | Alignment = taCenter 199 | AutoSize = False 200 | Caption = '...' 201 | ParentColor = False 202 | end 203 | object LabelCX16: TLabel 204 | Left = 214 205 | Height = 20 206 | Top = 120 207 | Width = 100 208 | Alignment = taCenter 209 | AutoSize = False 210 | Caption = '...' 211 | ParentColor = False 212 | end 213 | object LabelSAHF: TLabel 214 | Left = 316 215 | Height = 20 216 | Top = 120 217 | Width = 100 218 | Alignment = taCenter 219 | AutoSize = False 220 | Caption = '...' 221 | ParentColor = False 222 | end 223 | object LabelPF: TLabel 224 | Left = 418 225 | Height = 20 226 | Hint = 'Optional feature' 227 | Top = 120 228 | Width = 102 229 | Alignment = taCenter 230 | AutoSize = False 231 | Caption = '...' 232 | ParentColor = False 233 | ParentShowHint = False 234 | ShowHint = True 235 | end 236 | object LabelDISK: TLabel 237 | Left = 8 238 | Height = 20 239 | Top = 168 240 | Width = 512 241 | Alignment = taCenter 242 | AutoSize = False 243 | Caption = '...' 244 | ParentColor = False 245 | ParentShowHint = False 246 | ShowHint = True 247 | end 248 | object LabelSSE4_1: TLabel 249 | Left = 8 250 | Height = 20 251 | Top = 144 252 | Width = 102 253 | Alignment = taCenter 254 | AutoSize = False 255 | Caption = '...' 256 | ParentColor = False 257 | end 258 | object LabelSSE4_2: TLabel 259 | Left = 112 260 | Height = 20 261 | Top = 144 262 | Width = 100 263 | Alignment = taCenter 264 | AutoSize = False 265 | Caption = '...' 266 | ParentColor = False 267 | end 268 | object LabelNX: TLabel 269 | Left = 214 270 | Height = 20 271 | Hint = 'Optional feature' 272 | Top = 144 273 | Width = 100 274 | Alignment = taCenter 275 | AutoSize = False 276 | Caption = '...' 277 | ParentColor = False 278 | ParentShowHint = False 279 | ShowHint = True 280 | end 281 | object LabelAVX: TLabel 282 | Left = 316 283 | Height = 20 284 | Hint = 'Optional feature' 285 | Top = 144 286 | Width = 100 287 | Alignment = taCenter 288 | AutoSize = False 289 | Caption = '...' 290 | ParentColor = False 291 | ParentShowHint = False 292 | ShowHint = True 293 | end 294 | object LabelPDPE1GB: TLabel 295 | Left = 418 296 | Height = 20 297 | Hint = 'Optional feature' 298 | Top = 144 299 | Width = 102 300 | Alignment = taCenter 301 | AutoSize = False 302 | Caption = '...' 303 | ParentColor = False 304 | ParentShowHint = False 305 | ShowHint = True 306 | end 307 | object LabelResult: TLabel 308 | Left = 8 309 | Height = 32 310 | Top = 208 311 | Width = 512 312 | Alignment = taCenter 313 | AutoSize = False 314 | Font.Color = clWhite 315 | Font.Height = -23 316 | ParentColor = False 317 | ParentFont = False 318 | ParentShowHint = False 319 | ShowHint = True 320 | end 321 | end 322 | -------------------------------------------------------------------------------- /unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, 9 | Windows, CpuInterface, Clipbrd; 10 | 11 | type 12 | 13 | { TForm1 } 14 | 15 | TForm1 = class(TForm) 16 | Button1: TButton; 17 | Button2: TButton; 18 | Image1: TImage; 19 | Label1: TLabel; 20 | LabelResult: TLabel; 21 | LabelNX: TLabel; 22 | LabelDISK: TLabel; 23 | LabelCX16: TLabel; 24 | LabelPDPE1GB: TLabel; 25 | LabelSSE4_2: TLabel; 26 | LabelSAHF: TLabel; 27 | LabelPF: TLabel; 28 | Label2: TLabel; 29 | Label3: TLabel; 30 | Label4: TLabel; 31 | Label5: TLabel; 32 | Label6: TLabel; 33 | Label7: TLabel; 34 | LabelAVX: TLabel; 35 | LabelSSE3: TLabel; 36 | LabelPOPCNT: TLabel; 37 | LabelSSE4_1: TLabel; 38 | procedure Button1Click(Sender: TObject); 39 | procedure Button2Click(Sender: TObject); 40 | procedure Image1Click(Sender: TObject); 41 | procedure Label6Click(Sender: TObject); 42 | private 43 | 44 | public 45 | 46 | end; 47 | 48 | var 49 | Form1: TForm1; 50 | 51 | implementation 52 | 53 | uses cpu, LCLIntf; 54 | 55 | {$R *.lfm} 56 | 57 | { TForm1 } 58 | 59 | function IsWindows64: boolean; 60 | { 61 | Detect if we are running on 64 bit Windows or 32 bit Windows, 62 | independently of bitness of this program. 63 | Original source: 64 | http://www.delphipraxis.net/118485-ermitteln-ob-32-bit-oder-64-bit-betriebssystem.html 65 | modified for FreePascal in German Lazarus forum: 66 | http://www.lazarusforum.de/viewtopic.php?f=55&t=5287 67 | } 68 | {$ifdef WIN32} //Modified KpjComp for 64bit compile mode 69 | type 70 | TIsWow64Process = function( // Type of IsWow64Process API fn 71 | Handle: THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall; 72 | var 73 | IsWow64Result: Windows.BOOL; // Result from IsWow64Process 74 | IsWow64Process: TIsWow64Process; // IsWow64Process fn reference 75 | begin 76 | // Try to load required function from kernel32 77 | IsWow64Process := TIsWow64Process(Windows.GetProcAddress( 78 | Windows.GetModuleHandle('kernel32'), 'IsWow64Process')); 79 | if Assigned(IsWow64Process) then 80 | begin 81 | // Function is implemented: call it 82 | if not IsWow64Process(Windows.GetCurrentProcess, IsWow64Result) then 83 | raise SysUtils.Exception.Create('IsWindows64: bad process handle'); 84 | // Return result of function 85 | Result := IsWow64Result; 86 | end 87 | else 88 | // Function not implemented: can't be running on Wow64 89 | Result := False; 90 | {$else} //if were running 64bit code, OS must be 64bit :) 91 | begin 92 | Result := True; 93 | {$endif} 94 | end; 95 | 96 | type 97 | MEMORYSTATUSEX = record 98 | dwLength : DWORD; 99 | dwMemoryLoad : DWORD; 100 | ullTotalPhys : uint64; 101 | ullAvailPhys : uint64; 102 | ullTotalPageFile : uint64; 103 | ullAvailPageFile : uint64; 104 | ullTotalVirtual : uint64; 105 | ullAvailVirtual : uint64; 106 | ullAvailExtendedVirtual : uint64; 107 | end; 108 | 109 | function GlobalMemoryStatusEx(var Buffer: MEMORYSTATUSEX): BOOL; stdcall; external 'kernel32' name 'GlobalMemoryStatusEx'; 110 | 111 | function GetSystemMem: uint64; 112 | var MS_Ex: MemoryStatusEx; 113 | begin 114 | result := 0; 115 | FillChar(MS_Ex, SizeOf(MemoryStatusEx), 0); 116 | MS_Ex.dwLength := SizeOf(MemoryStatusEx); 117 | if GlobalMemoryStatusEx(MS_Ex) then 118 | result := (MS_Ex.ullTotalPhys + 1024*1024*512) div (1024*1024*1024); // FormatFloat('###.##', MS_Ex.ullTotalPhys / (1024*1024*1024)) + ' GB'; 119 | // TODO round up 120 | end; 121 | 122 | function supportedFeature(const cpuIntf: ICpuIdentifier; const feature: string): string; 123 | begin 124 | result := ''; 125 | if (cpuIntf.hasFeature(feature)) then 126 | begin 127 | result := feature; 128 | end; 129 | end; 130 | 131 | function reportAllSupportedFeatures(const cpuIntf: ICpuIdentifier): string; 132 | const 133 | startFeatureIndex = 0; 134 | endFeatureIndex = 58; 135 | var features : array [startFeatureIndex..endFeatureIndex] of string = ( 136 | 'SSE3', 'PCLMULQDQ', 'DTES64', 'MONITOR', 'DS-CPL', 'VMX', 137 | 'SMX', 'EIST', 'TM2', 'SSSE3', 'CNXT-ID', 'SDBG', 'FMA', 138 | 'CMPXCHG16B', 'xTPR', 'PDCM', 'PCID', 'DCA', 'SSE4_1', 139 | 'SSE4_2', 'x2APIC', 'MOVBE', 'POPCNT', 'TSC-DEADLINE', 140 | 'AES', 'XSAVE', 'OSXSAVE', 'AVX', 'F16C', 141 | 'RDRAND', 'FPU', 'VME', 'DE', 'PSE', 'TSC', 'MSR', 142 | 'PAE', 'MCE', 'CX8', 'APIC', 'SEP', 'MTRR', 'PGE', 143 | 'MCA', 'CMOV', 'PAT', 'PSE-36', 'PSN', 'CLFSH', 'DS', 144 | 'ACPI', 'MMX', 'FXSR', 'SSE', 'SSE2', 'SS', 'HTT', 'TM', 'PBE' 145 | ); 146 | 147 | i:integer; 148 | tmp:string; 149 | width:integer; 150 | begin 151 | result:=''; 152 | width:=0; 153 | for i := startFeatureIndex to endFeatureIndex do 154 | begin 155 | tmp:= supportedFeature(cpuIntf, features[i]); 156 | if (length(tmp) > 0) then 157 | begin 158 | //if i mod 10 = 0 then 159 | // result:= result + tmp + ''#13#10'' 160 | //else 161 | result:= result + tmp + ' '; 162 | width := width + length(tmp) + 1; 163 | if width > 40 then begin 164 | width := 0; 165 | result:= result + ''#13#10'' 166 | end; 167 | end; 168 | end; 169 | end; 170 | 171 | type 172 | TDriveLayoutInformationMbr = record 173 | Signature: DWORD; 174 | end; 175 | 176 | TDriveLayoutInformationGpt = record 177 | DiskId: TGuid; 178 | StartingUsableOffset: Int64; 179 | UsableLength: Int64; 180 | MaxPartitionCount: DWORD; 181 | end; 182 | 183 | TPartitionInformationMbr = record 184 | PartitionType: Byte; 185 | BootIndicator: Boolean; 186 | RecognizedPartition: Boolean; 187 | HiddenSectors: DWORD; 188 | end; 189 | 190 | TPartitionInformationGpt = record 191 | PartitionType: TGuid; 192 | PartitionId: TGuid; 193 | Attributes: Int64; 194 | Name: array [0..35] of WideChar; 195 | end; 196 | 197 | TPartitionInformationEx = record 198 | PartitionStyle: Integer; 199 | StartingOffset: Int64; 200 | PartitionLength: Int64; 201 | PartitionNumber: DWORD; 202 | RewritePartition: Boolean; 203 | case Integer of 204 | 0: (Mbr: TPartitionInformationMbr); 205 | 1: (Gpt: TPartitionInformationGpt); 206 | end; 207 | 208 | TDriveLayoutInformationEx = record 209 | PartitionStyle: DWORD; 210 | PartitionCount: DWORD; 211 | DriveLayoutInformation: record 212 | case Integer of 213 | 0: (Mbr: TDriveLayoutInformationMbr); 214 | 1: (Gpt: TDriveLayoutInformationGpt); 215 | end; 216 | PartitionEntry: array [0..15] of TPartitionInformationGpt; 217 | //hard-coded maximum of 16 partitions 218 | end; 219 | 220 | const 221 | PARTITION_STYLE_MBR = 0; 222 | PARTITION_STYLE_GPT = 1; 223 | PARTITION_STYLE_RAW = 2; 224 | 225 | const 226 | IOCTL_DISK_GET_DRIVE_LAYOUT_EX = $00070050; 227 | 228 | function layout: string; 229 | const 230 | // Max number of drives assuming primary/secondary, master/slave topology 231 | MAX_IDE_DRIVES = 16; 232 | var 233 | i: Integer; 234 | Drive: string; 235 | hDevice: THandle; 236 | DriveLayoutInfo: TDriveLayoutInformationEx; 237 | BytesReturned: DWORD; 238 | begin 239 | result := '{'; 240 | for i := 0 to MAX_IDE_DRIVES - 1 do 241 | begin 242 | Drive := '\\.\PHYSICALDRIVE' + IntToStr(i); 243 | hDevice := CreateFile(PChar(Drive), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, 244 | nil, OPEN_EXISTING, 0, 0); 245 | if hDevice <> INVALID_HANDLE_VALUE then 246 | begin 247 | if DeviceIoControl(hDevice, IOCTL_DISK_GET_DRIVE_LAYOUT_EX, nil, 0, 248 | @DriveLayoutInfo, SizeOf(DriveLayoutInfo), BytesReturned, nil) then 249 | begin 250 | case DriveLayoutInfo.PartitionStyle of 251 | PARTITION_STYLE_MBR: 252 | result := result + '(MBR)'; 253 | //Writeln(Drive + ', MBR, ' + 254 | // IntToHex(DriveLayoutInfo.DriveLayoutInformation.Mbr.Signature, 8)); 255 | PARTITION_STYLE_GPT: 256 | result := result + '(GPT)'; 257 | //Writeln(Drive + ', GPT, ' + 258 | // GUIDToString(DriveLayoutInfo.DriveLayoutInformation.Gpt.DiskId)); 259 | PARTITION_STYLE_RAW: 260 | result := result + '(GPT)'; 261 | //Writeln(Drive + ', RAW'); 262 | end; 263 | end; 264 | CloseHandle(hDevice); 265 | end; 266 | end; 267 | 268 | result := result + '}'; 269 | end; 270 | 271 | procedure TForm1.Button1Click(Sender: TObject); 272 | var 273 | cpus: LongWord; 274 | w64: boolean; 275 | mem: uint64; 276 | processor : ICpuIdentifier; 277 | bad: boolean; 278 | 279 | procedure red(text: TLabel); 280 | begin 281 | text.Color := clRed; 282 | bad := true; 283 | end; 284 | begin 285 | cpus := GetCPUCount(); 286 | w64 := IsWindows64; 287 | mem := GetSystemMem; 288 | processor := TCpuIdentifier.Create(); 289 | bad := false; 290 | 291 | Label1.Caption :='CPU threads count is ' + IntToStr(cpus); 292 | if cpus > 1 then 293 | Label1.Color := clMoneyGreen 294 | else red(Label1); 295 | 296 | if w64 then begin 297 | Label2.Color := clMoneyGreen; 298 | // red(Label2); // Uncomment to simulate failure 299 | Label2.Caption := 'CPU is 64-bit'; 300 | end else begin 301 | red(Label2); 302 | Label2.Caption := 'CPU is 32-bit'; 303 | end; 304 | 305 | Button2.Enabled := true; 306 | 307 | if mem > 1 then begin 308 | Label4.Color := clMoneyGreen; 309 | end else begin 310 | red(Label4); 311 | end; 312 | 313 | Label4.Caption := 'RAM is ' + FormatFloat('###.##', mem) + ' GB'; 314 | 315 | Label7.Caption := Trim(processor.processorName()); 316 | 317 | if processor.hasFeature('x2APIC') then 318 | Label7.Caption := Label7.Caption + ' (x2APIC)' 319 | else Label7.Caption := Label7.Caption + ' (Legacy APIC)'; 320 | 321 | if processor.hasFeature('x2APIC') or processor.hasFeature('APIC') then 322 | Label7.Color := clMoneyGreen 323 | else red(Label7); 324 | 325 | Label7.Hint := reportAllSupportedFeatures(processor); 326 | 327 | // '-msse3 -mpopcnt -mcx16 -msahf -mprfchw ', 328 | 329 | if processor.hasFeature('POPCNT') then 330 | LabelPOPCNT.Color := clMoneyGreen 331 | else red(LabelPOPCNT); 332 | LabelPOPCNT.Caption := 'POPCNT'; 333 | 334 | if processor.hasFeature('SSE3') then 335 | LabelSSE3.Color := clMoneyGreen 336 | else red(LabelSSE3); 337 | LabelSSE3.Caption := 'SSE3'; 338 | 339 | if processor.hasFeature('CMPXCHG16B') then 340 | LabelCX16.Color := clMoneyGreen 341 | else red(LabelCX16); 342 | LabelCX16.Caption := 'CMPXCHG16B'; 343 | 344 | if processor.hasFeature('SAHF') then 345 | LabelSAHF.Color := clMoneyGreen 346 | else red(LabelSAHF); 347 | LabelSAHF.Caption := 'SAHF'; 348 | 349 | if processor.hasFeature('PREFETCHW') then 350 | LabelPF.Color := clMoneyGreen 351 | else LabelPF.Color := clCream; 352 | LabelPF.Caption := 'PREFETCHW'; 353 | 354 | // --- 355 | 356 | if processor.hasFeature('SSE4_1') then 357 | LabelSSE4_1.Color := clMoneyGreen 358 | else red(LabelSSE4_1); 359 | LabelSSE4_1.Caption := 'SSE4_1'; 360 | 361 | if processor.hasFeature('SSE4_2') then 362 | LabelSSE4_2.Color := clMoneyGreen 363 | else red(LabelSSE4_2); 364 | LabelSSE4_2.Caption := 'SSE4_2'; 365 | 366 | if processor.hasFeature('NX') then 367 | LabelNX.Color := clMoneyGreen 368 | else LabelNX.Color := clCream; 369 | LabelNX.Caption := 'NX'; 370 | 371 | if processor.hasFeature('AVX') then 372 | LabelAVX.Color := clMoneyGreen 373 | else LabelAVX.Color := clCream; 374 | LabelAVX.Caption := 'AVX'; 375 | 376 | if processor.hasFeature('PDPE1GB') then 377 | LabelPDPE1GB.Color := clMoneyGreen 378 | else LabelPDPE1GB.Color := clCream; 379 | LabelPDPE1GB.Caption := 'PDPE1GB'; 380 | 381 | // TODO UEFI/GPT 382 | 383 | LabelDISK.Hint := layout; 384 | if pos('(GPT)', LabelDISK.Hint) > 1 then begin 385 | LabelDISK.Color := clMoneyGreen; 386 | LabelDISK.Caption := 'GPT partition scheme'; 387 | end else begin 388 | red(LabelDISK); 389 | LabelDISK.Caption := 'MBR partition scheme'; 390 | end; 391 | 392 | Button1.Visible := false; 393 | LabelResult.Visible := true; 394 | 395 | if bad then begin 396 | LabelResult.Color := $009D9DFF; 397 | LabelResult.Caption := 'Your device is too old to run Greentea OS'; 398 | end else begin 399 | LabelResult.Color := $00DADAB6; 400 | LabelResult.Caption := 'Your device is compatible with Greentea OS'; 401 | end; 402 | end; 403 | 404 | procedure TForm1.Button2Click(Sender: TObject); 405 | begin 406 | Clipboard.AsText := 407 | Label7.Caption + ''#13#10'' + 408 | Label1.Caption + ''#13#10'' + 409 | Label2.Caption + ''#13#10'' + 410 | Label4.Caption + ''#13#10'' + 411 | LabelDISK.Caption + ''#13#10'' + 412 | 413 | LabelPOPCNT.Caption + ''#13#10'' + 414 | LabelSSE3.Caption + ''#13#10'' + 415 | LabelCX16.Caption + ''#13#10'' + 416 | LabelSAHF.Caption + ''#13#10'' + 417 | LabelPF.Caption + ''#13#10'' + 418 | 419 | Label7.Hint + ''#13#10'' 420 | ; 421 | end; 422 | 423 | procedure TForm1.Image1Click(Sender: TObject); 424 | var 425 | found: boolean; 426 | begin 427 | found := OpenURL('https://greenteaos.github.io'); 428 | end; 429 | 430 | procedure TForm1.Label6Click(Sender: TObject); 431 | begin 432 | 433 | end; 434 | 435 | end. 436 | 437 | --------------------------------------------------------------------------------